From c714c442442ef137f20ca4ff9707d5480cb9ba7a Mon Sep 17 00:00:00 2001 From: Charles Forsyth Date: Wed, 29 Apr 2015 15:19:07 +0100 Subject: remove obsolete minitel, but leave source as example --- appl/examples/minitel/README | 209 +++++ appl/examples/minitel/event.b | 19 + appl/examples/minitel/event.m | 19 + appl/examples/minitel/keyb.b | 367 +++++++++ appl/examples/minitel/mdisplay.b | 799 +++++++++++++++++++ appl/examples/minitel/mdisplay.m | 115 +++ appl/examples/minitel/miniterm.b | 1187 ++++++++++++++++++++++++++++ appl/examples/minitel/miniterm.m | 120 +++ appl/examples/minitel/mkfile | 24 + appl/examples/minitel/modem.b | 620 +++++++++++++++ appl/examples/minitel/screen.b | 1610 ++++++++++++++++++++++++++++++++++++++ appl/examples/minitel/socket.b | 49 ++ appl/examples/minitel/swkeyb.b | 370 +++++++++ appl/examples/minitel/swkeyb.m | 21 + appl/wm/minitel/README | 209 ----- appl/wm/minitel/event.b | 19 - appl/wm/minitel/event.m | 19 - appl/wm/minitel/keyb.b | 367 --------- appl/wm/minitel/mdisplay.b | 799 ------------------- appl/wm/minitel/mdisplay.m | 115 --- appl/wm/minitel/miniterm.b | 1187 ---------------------------- appl/wm/minitel/miniterm.m | 120 --- appl/wm/minitel/mkfile | 24 - appl/wm/minitel/modem.b | 620 --------------- appl/wm/minitel/screen.b | 1610 -------------------------------------- appl/wm/minitel/socket.b | 49 -- appl/wm/minitel/swkeyb.b | 370 --------- appl/wm/minitel/swkeyb.m | 21 - 28 files changed, 5529 insertions(+), 5529 deletions(-) create mode 100644 appl/examples/minitel/README create mode 100644 appl/examples/minitel/event.b create mode 100644 appl/examples/minitel/event.m create mode 100644 appl/examples/minitel/keyb.b create mode 100644 appl/examples/minitel/mdisplay.b create mode 100644 appl/examples/minitel/mdisplay.m create mode 100644 appl/examples/minitel/miniterm.b create mode 100644 appl/examples/minitel/miniterm.m create mode 100644 appl/examples/minitel/mkfile create mode 100644 appl/examples/minitel/modem.b create mode 100644 appl/examples/minitel/screen.b create mode 100644 appl/examples/minitel/socket.b create mode 100644 appl/examples/minitel/swkeyb.b create mode 100644 appl/examples/minitel/swkeyb.m delete mode 100644 appl/wm/minitel/README delete mode 100644 appl/wm/minitel/event.b delete mode 100644 appl/wm/minitel/event.m delete mode 100644 appl/wm/minitel/keyb.b delete mode 100644 appl/wm/minitel/mdisplay.b delete mode 100644 appl/wm/minitel/mdisplay.m delete mode 100644 appl/wm/minitel/miniterm.b delete mode 100644 appl/wm/minitel/miniterm.m delete mode 100644 appl/wm/minitel/mkfile delete mode 100644 appl/wm/minitel/modem.b delete mode 100644 appl/wm/minitel/screen.b delete mode 100644 appl/wm/minitel/socket.b delete mode 100644 appl/wm/minitel/swkeyb.b delete mode 100644 appl/wm/minitel/swkeyb.m diff --git a/appl/examples/minitel/README b/appl/examples/minitel/README new file mode 100644 index 00000000..82f3202e --- /dev/null +++ b/appl/examples/minitel/README @@ -0,0 +1,209 @@ +Minitel Emulation for Inferno + +This directory contains the source of `miniterm', a minitel emulator +for Inferno. Miniterm is written in Limbo. The main components are: + + miniterm.m - common constants + miniterm.b - terminal emulator, messaging and Minitel `protocol` + event.[mb] - inter-module message format + keyb.b - Minitel keyboard module + modem.b - Minitel modem module + screen.b - Minitel screen module + socket.b - Minitel socket module + arg.m - basic command line argument handling + mdisplay.[mb] - Videotex display module + swkeyb.[mb] - Minitel aware software keyboard + + fonts.tgz which expands into: + + fonts/minitel - external and subfont directory (`bind -b' into /fonts) + fonts/minitel/f40x25 - 40 column external font + fonts/minitel/14x17 + fonts/minitel/14x17xoe + fonts/minitel/14x17arrow + fonts/minitel/f40x25g1 - 40 column semigraphic external font + fonts/minitel/vid14x17 + fonts/minitel/f40x25h - 40 column double height external font + fonts/minitel/14x34 + fonts/minitel/14x34xoe + fonts/minitel/14x34arrow + fonts/minitel/f40x25w - 40 column double width external font + fonts/minitel/28x17 + fonts/minitel/28x17xoe + fonts/minitel/28x17arrow + fonts/minitel/f40x25s - 40 column double size external font + fonts/minitel/28x34xoe + fonts/minitel/28x34arrow + fonts/minitel/f80x25 - 80 column external font + fonts/minitel/8x12 + fonts/minitel/8x12xoe + fonts/minitel/8x12arrow + +The fonts subdirectory should be bound into /fonts: + bind -b fonts /fonts +or the directory fonts/minitel copied to /fonts/minitel before invoking the emulator. +The names of the external fonts are +known to the Videotex display module. Similarly, the files: + /dev/modem + /dev/modemctl +are known to the modem module, but you can ignore them if +(as is almost certain) you are using the Internet-minitel gateway +and you haven't got appropriate modem hardware anyway. + +To build + mkdir /usr/inferno/dis/wm/minitel + mk install + +The code models the structure outlined in the Minitel 1B specification +provided by France Telecom. However, much more interpretation was +required to display the majority of screens currently seen on Minitel. +Additional information (although sketchy) was found on the Internet by +searching for Minitel or Videotex and also by examination of the codes +sent by minitel servers and experimenting with replies. There must be +some more up to date information somewhere! + +We don't support downloadable fonts, but correctly filter them out. + +The file miniterm.b contains the code for the minitel `terminal' with +which the other modules communicate. The keyboard, modem, socket, +screen and terminal are run as separate threads which communicate by +calling: + send(e: ref Event) +The clue to the intermodule communication is in Terminal.run which +does something like: + for(;;) { + ev =<- t.in => + eva := protocol(ev); + while(len eva > 0) { + post(eva[0]); + eva = eva[1:]; + } + # then deliver any `posted' messages (without blocking) + } +An Event `ev' may typically be an Edata type (say from the modem) or +an Eproto type for internal interpretation. In the call: + eva := protocol(ev) +The function protocol() dissects Edata messages to produce an inline +sequence of Edata and Eproto messages. The function post() queues +messages for delivery to the appropriate modules. For example, data +from the modem might be destined for the screen and the socket module. +Messages are queued until they can be delivered. That way the line: + ev =<- t.in +is executed in a timely way and the other modules can be written to +make blocking writes (via send()) and to service reads when they are +ready. + +In many places in the code lines appear with comments like: + if(p.skip < 1 || p.skip > 127) # 5.0 +These refer to sections of the Minitel specification which explain the +code. + +The mdisplay code provides a Videotex display using Inferno +primitives. The screen, keyboard and modem modules interpret data as +described in the equivalent section of the Minitel specification. The +socket module has not been implemented but currently performs a `null' +function and could easily be added if required. + + +- Namespace +We always expect the fonts to appear in /fonts and the softmodem +to appear as /dev/modem and /dev/modemctl. + +- Invocation +If invoked with no argument, miniterm uses the France Telecom +internet gateway by default (tcp!193.252.252.250!513). +If the argument starts with `modem' then +a direct connection through /dev/modem will be established. + +An argument beginning with anything other than `modem' will +be assumed to be an address suitable for dial(). For example: + + wm/minitel/miniterm tcp!193.252.252.250!513 + +will connect to the current France Telecom internet server. + +For direct connections a modem `init' string and an optional +phone number can follow the modem prefix, as in: + + wm/minitel/miniterm modem!F3!3615 + +or + + wm/minitel/miniterm modem!F3!01133836431414 + +The `F3' is the code which instructs the softmodem to enable V.23 +and needs to be passed when connecting to the FT servers. +To use pulse dialing instead of tone dialing the phone number +can be prefixed with a 'P' as in: + + wm/minitel/miniterm modem!F3!P3614 + +If the parameter specifies a network connection or a direct connection +with a phone number the software will attempt to connect immediately. +If Cx/Fin is used to disconnect and then re-connect it will use the +same IP address for a network connection or prompt for a new +phone number in the case of a direct connection. When prompting +for a new number the top row of the screen is used to allow the user +to edit the last used number. Simple editing is available, and the minitel +keys do the obvious things. + + + +** Notes on the 15th December 1998 Release ** + +- Software keyboard +A version of the software keyboard which understands some of +the minitel keyboard mappings is included. For example, hitting 'A' results +in a capital 'A' on the screen in spite of the Videotex case mapping. + +- Minitel function keys +The minitel keys are displayed on the right hand side of the screen +in 40 column mode on a network connection +and can be swapped to the left hand side by hitting the <- key. +In direct dial mode and 80 column network mode the keys are +displayed at the bottom of the screen. +In network mode they are re-displayed as appropriate on 40 to 80 +column mode changes. + + +Known Omission +------------- +- Error Correction (direct dial only) +There is no screen button to enable error correction in the release. +If a server asks for error correction it will be enabled. It looks as though +we need to include a key to enable it. Without it direct dial screens are +occasionally corrupted. + +- Software Keyboard Handling +We need to add some code to update the software keyboard and +bring it to the foreground on a mode change. + +- Full 80 column support +I am aware of some screens which don't look correct in 80 column +mode (and others that do). See `EMAIL' then choose USENET and +press SUITE a few times. I believe it behaves as specified but as we +have seen with the 40 column Videotex mode the specification +is not sufficient to display most of the minitel screens correctly. +80 column support needs just a little more work. +It may be, too, that the 80 column font could be made much more +readable by utilising a few more pixels on the screen now that we +are able to cover the toolbar. + +- Full toolbar integration +Experimentation will show whether there needs to be more +integration with the toolbar. + +Known Bugs +---------- +- Softmodem disconnection +Often, the modem does not hangup correctly. + +- Choose `USA' from a network connection +USA (from a network connection) gives an `iC' in bottom left hand +corner of screen. Possibly a server issue. Doesn't occur when +connecting directly. The server is really sending this sequence. +Both the FT emulator and their explorer plug-in suffer from it too. + + +John Bates +Vita Nuova Limited diff --git a/appl/examples/minitel/event.b b/appl/examples/minitel/event.b new file mode 100644 index 00000000..f751f55b --- /dev/null +++ b/appl/examples/minitel/event.b @@ -0,0 +1,19 @@ +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +Event.str(ev: self ref Event) : string +{ + s := "?"; + pick e := ev { + Edata => + s = sprint("Edata %d = ", len e.data); + for(i:=0; i + s = "Equit"; + Eproto => + s = sprint("Eproto %ux (%s)", e.cmd, e.s); + } + return s; +} diff --git a/appl/examples/minitel/event.m b/appl/examples/minitel/event.m new file mode 100644 index 00000000..1b524363 --- /dev/null +++ b/appl/examples/minitel/event.m @@ -0,0 +1,19 @@ +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +Event: adt { + path: int; # path for delivery + from: int; # sending module (for reply) + pick { + Edata => + data: array of byte; + Eproto => + cmd: int; + s: string; + a0, a1, a2: int; # parameters + Equit => + } + + str: fn(e: self ref Event) : string; # convert to readable form +}; diff --git a/appl/examples/minitel/keyb.b b/appl/examples/minitel/keyb.b new file mode 100644 index 00000000..aba5485d --- /dev/null +++ b/appl/examples/minitel/keyb.b @@ -0,0 +1,367 @@ +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +# special keyboard operations +Extend, # enable cursor and editing keys and control chars +C0keys, # cursor keys send BS,HT,LF and VT +Invert # case inversion + : con 1 << iota; + +Keyb: adt { + m: ref Module; # common attributes + in: chan of ref Event; + + cmd: chan of string; # from Tk (keypresses and focus) + spec: int; # special keyboard extensions + + init: fn(k: self ref Keyb, toplevel: ref Tk->Toplevel); + reset: fn(k: self ref Keyb); + run: fn(k: self ref Keyb); + quit: fn(k: self ref Keyb); + map: fn(k: self ref Keyb, key:int): array of byte; +}; + +Keyb.init(k: self ref Keyb, toplevel: ref Tk->Toplevel) +{ + k.in = chan of ref Event; + k.cmd = chan of string; + tk->namechan(toplevel, k.cmd, "keyb"); # Tk -> keyboard + k.reset(); +} + +Keyb.reset(k: self ref Keyb) +{ + k.m = ref Module(Pmodem|Psocket, 0); +} + +ask(in: chan of string, out: chan of string) +{ + keys: string; + + T.mode = Videotex; + S.setmode(Videotex); +# clear(S); + prompt: con "Numéroter: "; + number := M.lastdialstr; + S.msg(prompt); + +Input: + for(;;) { + n := len prompt + len number; + # guard length must be > len prompt + if (n > 30) + n -= 30; + else + n = 0; + S.msg(prompt + number[n:]); + keys = <- in; + if (keys == nil) + return; + + keys = canoncmd(keys); + + case keys { + "connect" or "send" => + break Input; + "correct" => + if(len number > 0) + number = number[0: len number -1]; + "cancel" => + number = ""; + break Input; + "repeat" or "index" or "guide" or "next" or "previous" => + ; + * => + number += keys; + } + } + + S.msg(nil); + for (;;) alt { + out <- = number => + return; + keys = <- in => + if (keys == nil) + return; + } +} + +Keyb.run(k: self ref Keyb) +{ + dontask := chan of string; + askchan := dontask; + askkeys := chan of string; +Runloop: + for(;;){ + alt { + ev := <- k.in => + pick e := ev { + Equit => + break Runloop; + Eproto => + case e.cmd { + Creset => + k.reset(); + Cproto => + case e.a0 { + START => + case e.a1 { + LOWERCASE => + k.spec |= Invert; + } + STOP => + case e.a1 { + LOWERCASE => + k.spec &= ~Invert; + } + } + * => break; + } + } + cmd := <- k.cmd => + if(debug['k'] > 0) { + fprint(stderr, "Tk %s\n", cmd); + } + (n, args) := sys->tokenize(cmd, " "); + if(n >0) + case hd args { + "key" => + (key, nil) := toint(hd tl args, 16); + if(askchan != dontask) { + s := minikey(key); + if (s == nil) + s[0] = key; + askkeys <-= s; + break; + } + keys := k.map(key); + if(keys != nil) { + send(ref Event.Edata(k.m.path, Mkeyb, keys)); + } + "skey" => # minitel key hit (soft key) + if(hd tl args == "Exit") { + if(askchan != dontask) { + askchan = dontask; + askkeys <-= nil; + } + if(T.state == Online || T.state == Connecting) { + seq := keyseq("connect"); + if(seq != nil) { + send(ref Event.Edata(k.m.path, Mkeyb, seq)); + send(ref Event.Edata(k.m.path, Mkeyb, seq)); + } + send(ref Event.Eproto(Pmodem, Mkeyb, Cdisconnect, "", 0,0,0)); + } + send(ref Event.Equit(0, 0)); + break; + } + if(askchan != dontask) { + askkeys <-= hd tl args; + break; + } + case hd tl args { + "Connect" => + case T.state { + Local => + if(M.connect == Network) + send(ref Event.Eproto(Pmodem, Mkeyb, Cconnect, "", 0,0,0)); + else { + askchan = chan of string; + spawn ask(askkeys, askchan); + } + Connecting => + send(ref Event.Eproto(Pmodem, Mkeyb, Cdisconnect, "", 0,0,0)); + Online => + seq := keyseq("connect"); + if(seq != nil) + send(ref Event.Edata(k.m.path, Mkeyb, seq)); + } + * => + seq := keyseq(hd tl args); + if(seq != nil) + send(ref Event.Edata(k.m.path, Mkeyb, seq)); + } + "click" => # fetch a word from the display + x := int hd tl args; + y := int hd tl tl args; + word := disp->GetWord(Point(x, y)); + if(word != nil) { + if (askchan != dontask) { + askkeys <- = word; + break; + } + if (T.state == Local) { + if (canoncmd(word) == "connect") { + if(M.connect == Network) + send(ref Event.Eproto(Pmodem, Mkeyb, Cconnect, "", 0,0,0)); + else { + askchan = chan of string; + spawn ask(askkeys, askchan); + } + break; + } + } + seq := keyseq(word); + if(seq != nil) + send(ref Event.Edata(k.m.path, Mkeyb, seq)); + else { + send(ref Event.Edata(k.m.path, Mkeyb, array of byte word )); + send(ref Event.Edata(k.m.path, Mkeyb, keyseq("send"))); + } + } + + } + dialstr := <-askchan => + askchan = dontask; + if(dialstr != nil) { + M.dialstr = dialstr; + send(ref Event.Eproto(Pmodem, Mkeyb, Cconnect, "", 0,0,0)); + } + } + } + send(nil); +} + + +# Perform mode specific key translation +# returns nil on invalid keypress, +Keyb.map(nil: self ref Keyb, key: int): array of byte +{ + # hardware to minitel keyboard mapping + cmd := minikey(key); + if (cmd != nil) { + seq := keyseq(cmd); + if(seq != nil) + return seq; + } + + # alphabetic (with case mapping) + case T.mode { + Videotex => + if(key >= 'A' && key <= 'Z') + return array [] of { byte ('a' + (key - 'A'))}; + if(key >= 'a' && key <= 'z') + return array [] of {byte ('A' + (key - 'a'))}; + Mixed or Ascii => + if(key >= 'A' && key <= 'Z' || key >= 'a' && key <= 'z') + return array [] of {byte key}; + }; + + # Numeric + if(key >= '0' && key <= '9') + return array [] of {byte key}; + + # Control-A -> Control-Z, Esc - columns 0 and 1 + if(key >= 16r00 && key <=16r1f) + case T.mode { + Videotex => + return nil; + Mixed or Ascii => + return array [] of {byte key}; + } + + # miscellaneous key mapping + case key { + 16r20 => ; # space + 16ra3 => return array [] of { byte 16r19, byte 16r23 }; # pound + '!' or '"' or '#' or '$' + or '%' or '&' or '\'' or '(' or ')' + or '*' or '+' or ',' or '-' + or '.' or ':' or ';' or '<' + or '=' or '>' or '?' or '@' => ; + KF13 => # request for error correction - usually Fnct M + C + if((M.spec&Ecp) == 0 && T.state == Online && T.connect == Direct) { +fprint(stderr, "requesting Ecp\n"); + return array [] of { byte SEP, byte 16r4a }; + } + return nil; + * => return nil; + } + return array [] of {byte key}; +} + +Keyb.quit(k: self ref Keyb) +{ + if(k==nil); +} + +canoncmd(s : string) : string +{ + s = tolower(s); + case s { + "connect" or "cx/fin" or + "connexion" or "fin" => return "connect"; + "send" or "envoi" => return "send"; + "repeat" or "repetition" => return "repeat"; + "index" or "sommaire" or "somm" + => return "index"; + "guide" => return "guide"; + "correct" or "correction" => return "correct"; + "cancel" or "annulation" or "annul" or "annu" + => return "cancel"; + "next" or "suite" => return "next"; + "previous" or "retour" or "retou" + => return "previous"; + } + return s; +} + +# map softkey names to the appropriate byte sequences +keyseq(skey: string): array of byte +{ + b2 := 0; + asterisk := 0; + if(skey == nil || len skey == 0) + return nil; + if(skey[0] == '*') { + asterisk = 1; + skey = skey[1:]; + } + skey = canoncmd(skey); + case skey { + "connect" => b2 = 16r49; + "send" => b2 = 16r41; + "repeat" => b2 = 16r43; + "index" => b2 = 16r46; + "guide" => b2 = 16r44; + "correct" => b2 = 16r47; + "cancel" => b2 = 16r45; + "next" => b2 = 16r48; + "previous" => b2 = 16r42; + } + if(b2) { + if(asterisk) + return array [] of { byte '*', byte SEP, byte b2}; + else + return array [] of { byte SEP, byte b2}; + } else + return nil; +} + +# map hardware or software keyboard presses to minitel functions +minikey(key: int): string +{ + case key { + Kup or KupPC => + return"previous"; + Kdown or KdownPC => + return "next"; + Kenter => + return "send"; + Kback => + return "correct"; + Kesc => + return "cancel"; + KF1 => + return "guide"; + KF2 => + return "connect"; + KF3 => + return "repeat"; + KF4 => + return "index"; + * => + return nil; + } +} \ No newline at end of file diff --git a/appl/examples/minitel/mdisplay.b b/appl/examples/minitel/mdisplay.b new file mode 100644 index 00000000..b3c629f9 --- /dev/null +++ b/appl/examples/minitel/mdisplay.b @@ -0,0 +1,799 @@ +implement MDisplay; + +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# +# - best viewed with acme! + +include "sys.m"; +include "draw.m"; +include "mdisplay.m"; + +sys : Sys; +draw : Draw; + +Context, Point, Rect, Font, Image, Display, Screen : import draw; + + +# len cell == number of lines +# len cell[0] == number of cellmap cells per char +# (x,y)*cellsize == font glyph clipr + +cellS := array [] of {array [] of {(0, 0)}}; +cellW := array [] of {array [] of {(0, 0), (1, 0)}}; +cellH := array [] of {array [] of {(0, 1)}, array [] of {(0, 0)}}; +cellWH := array [] of {array [] of {(0, 1), (1, 1)}, array [] of {(0, 0), (1, 0)}}; + +Cellinfo : adt { + font : ref Font; + ch, attr : int; + clipmod : (int, int); +}; + + +# current display attributes +display : ref Display; +window : ref Image; +frames := array [2] of ref Image; +update : chan of int; + +colours : array of ref Image; +bright : ref Image; + +# current mode attributes +cellmap : array of Cellinfo; +nrows : int; +ncols : int; +ulheight : int; +curpos : Point; +winoff : Point; +cellsize : Point; +modeattr : con fgWhite | bgBlack; +showC := 0; +delims := 0; +modbbox := Rect((0,0),(0,0)); +blankrow : array of Cellinfo; + +ctxt : ref Context; +font : ref Font; # g0 videotex font - extended with unicode g2 syms +fonth : ref Font; # double height version of font +fontw : ref Font; # double width +fonts : ref Font; # double size +fontg1 : ref Font; # semigraphic videotex font (ch+128=separated) +fontfr : ref Font; # french character set +fontusa : ref Font; # american character set + + +Init(c : ref Context) : string +{ + sys = load Sys Sys->PATH; + draw = load Draw Draw->PATH; + + if (c == nil || c.display == nil) + return "no display context"; + + ctxt = c; + disp := ctxt.display; + + black := disp.rgb2cmap(0, 0, 0); + blue := disp.rgb2cmap(0, 0, 255); + red := disp.rgb2cmap(255, 0, 0); + magenta := disp.rgb2cmap(255, 0, 255); + green := disp.rgb2cmap(0, 255, 0); + cyan := disp.rgb2cmap(0, 255, 255); + yellow := disp.rgb2cmap(255, 255, 0); + white := disp.rgb2cmap(240, 240, 240); + + iblack := disp.color(black); + iblue := disp.color(blue); + ired := disp.color(red); + imagenta := disp.color(magenta); + igreen := disp.color(green); + icyan := disp.color(cyan); + iyellow := disp.color(yellow); + iwhite := disp.color(white); + + colours = array [] of { iblack, iblue, ired, imagenta, + igreen, icyan, iyellow, iwhite}; + bright = disp.color(disp.rgb2cmap(255, 255, 255)); + + update = chan of int; + spawn Update(update); + display = disp; + return nil; +} + +Quit() +{ + if (update != nil) + update <- = QuitUpdate; + update = nil; + window = nil; + frames[0] = nil; + frames[1] = nil; + cellmap = nil; + display = nil; +} + +Mode(r : Draw->Rect, w, h, ulh, d : int, fontpath : string) : (string, ref Draw->Image) +{ + if (display == nil) + # module not properly Init()'d + return ("not initialized", nil); + + curpos = Point(-1, -1); + if (window != nil) + update <- = Pause; + + cellmap = nil; + window = nil; + (dx, dy) := (r.dx(), r.dy()); + if (dx == 0 || dy == 0) { + return (nil, nil); + } + + black := display.rgb2cmap(0, 0, 0); + window = ctxt.screen.newwindow(r, Draw->Refbackup, black); + if (window == nil) + return ("cannot create window", nil); + + window.origin(Point(0,0), r.min); + winr := Rect((0,0), (dx, dy)); + frames[0] = display.newimage(winr, window.chans, 0, black); + frames[1] = display.newimage(winr, window.chans, 0, black); + + if (window == nil || frames[0] == nil || frames[1] == nil) { + window = nil; + return ("cannot allocate display resources", nil); + } + + ncols = w; + nrows = h; + ulheight = ulh; + delims = d; + showC = 0; + + cellmap = array [ncols * nrows] of Cellinfo; + + font = Font.open(display, fontpath); + fontw = Font.open(display, fontpath + "w"); + fonth = Font.open(display, fontpath + "h"); + fonts = Font.open(display, fontpath + "s"); + fontg1 = Font.open(display, fontpath + "g1"); + fontfr = Font.open(display, fontpath + "fr"); + fontusa = Font.open(display, fontpath + "usa"); + + if (font != nil) + cellsize = Point(font.width(" "), font.height); + else + cellsize = Point(dx/ncols, dy / nrows); + + winoff.x = (dx - (cellsize.x * ncols)) / 2; + winoff.y = (dy - (cellsize.y * nrows)) /2; + if (winoff.x < 0) + winoff.x = 0; + if (winoff.y < 0) + winoff.y = 0; + + blankrow = array [ncols] of {* => Cellinfo(font, ' ', modeattr | fgWhite, (0,0))}; + for (y := 0; y < nrows; y++) { + col0 := y * ncols; + cellmap[col0:] = blankrow; + } + +# frames[0].clipr = frames[0].r; +# frames[1].clipr = frames[1].r; +# frames[0].draw(frames[0].r, colours[0], nil, Point(0,0)); +# frames[1].draw(frames[1].r, colours[0], nil, Point(0,0)); +# window.draw(window.r, colours[0], nil, Point(0,0)); + update <- = Continue; + return (nil, window); +} + +Cursor(pt : Point) +{ + if (update == nil || cellmap == nil) + # update thread (cursor/character flashing) not running + return; + + # normalize pt + pt.x--; + + curpos = pt; + update <- = CursorSet; +} + +Put(str : string, pt : Point, charset, attr, insert : int) +{ + if (cellmap == nil || str == nil) + # nothing to do + return; + + # normalize pt + pt.x--; + + f : ref Font; + cell := cellS; + + case charset { + videotex => + if (!(attr & attrD)) + attr &= (fgMask | attrF | attrH | attrW | attrP); + if (attr & attrW && attr & attrH) { + cell = cellWH; + f = fonts; + } else if (attr & attrH) { + cell = cellH; + f = fonth; + } else if (attr & attrW) { + cell = cellW; + f = fontw; + } else { + f = font; + } + + semigraphic => + f = fontg1; + if (attr & attrL) { + # convert to "separated" + newstr := ""; + for (ix := 0; ix < len str; ix++) + newstr[ix] = str[ix] + 16r80; + str = newstr; + } + # semigraphic charset does not support size / polarity attributes + # attrD always set later once field attr established + attr &= ~(attrD | attrH | attrW | attrP | attrL); + + french => f = fontfr; + american => f = fontusa; + * => f = font; + } + + update <- = Pause; + + txty := pt.y - (len cell - 1); + for (cellix := len cell - 1; cellix >= 0; cellix--) { + y := pt.y - cellix; + + if (y < 0) + continue; + if (y >= nrows) + break; + + col0 := y * ncols; + colbase := pt.y * ncols; + + if (delims && !(attr & attrD)) { + # seek back for a delimiter + mask : int; + delimattr := modeattr; + + # semigraphics only inherit attrC from current field + if (charset == semigraphic) + mask = attrC; + else + mask = bgMask | attrC | attrL; + + for (ix := pt.x-1; ix >= 0; ix--) { + cix := ix + col0; + if (cellmap[cix].attr & attrD) { + if (cellmap[cix].font == fontg1 && f != fontg1) + # don't carry over attrL from semigraphic field + mask &= ~attrL; + + delimattr = cellmap[cix].attr; + break; + } + } + attr = (attr & ~mask) | (delimattr & mask); + + # semigraphics validate background colour + if (charset == semigraphic) + attr |= attrD; + } + + strlen := len cell[0] * len str; + gfxwidth := cellsize.x * strlen; + srco := Point(pt.x*cellsize.x, y*cellsize.y); + + if (insert) { + # copy existing cells and display to new position + if (pt.x + strlen < ncols) { + for (destx := ncols -1; destx > pt.x; destx--) { + srcx := destx - strlen; + if (srcx < 0) + break; + cellmap[col0 + destx] = cellmap[col0 + srcx]; + } + + # let draw() do the clipping for us + dsto := Point(srco.x + gfxwidth, srco.y); + dstr := Rect((dsto.x, srco.y), (ncols * cellsize.x, srco.y + cellsize.y)); + + frames[0].clipr = frames[0].r; + frames[1].clipr = frames[1].r; + frames[0].draw(dstr, frames[0], nil, srco); + frames[1].draw(dstr, frames[1], nil, srco); + if (modbbox.dx() == 0) + modbbox = dstr; + else + modbbox = boundingrect(modbbox, dstr); + } + } + + # copy-in new string + x := pt.x; + for (strix := 0; x < ncols && strix < len str; strix++) { + for (clipix := 0; clipix < len cell[cellix]; (x, clipix) = (x+1, clipix+1)) { + if (x < 0) + continue; + if (x >= ncols) + break; + cmix := col0 + x; + cellmap[cmix].font = f; + cellmap[cmix].ch = str[strix]; + cellmap[cmix].attr = attr; + cellmap[cmix].clipmod = cell[cellix][clipix]; + } + } + + # render the new string + txto := Point(srco.x, txty * cellsize.y); + strr := Rect(srco, (srco.x + gfxwidth, srco.y + cellsize.y)); + if (strr.max.x > ncols * cellsize.x) + strr.max.x = ncols * cellsize.x; + + drawstr(str, f, strr, txto, attr); + + # redraw remainder of line until find cell not needing redraw + + # this could be optimised by + # spotting strings with same attrs, font and clipmod pairs + # and write out whole string rather than processing + # a char at a time + + attr2 := attr; + mask := bgMask | attrC | attrL; + s := ""; + for (; delims && x < ncols; x++) { + if (x < 0) + continue; + newattr := cellmap[col0 + x].attr; + + if (cellmap[col0 + x].font == fontg1) { + # semigraphics act as bg colour delimiter + attr2 = (attr2 & ~bgMask) | (newattr & bgMask); + mask &= ~attrL; + } else + if (newattr & attrD) + break; + + if ((attr2 & mask) == (newattr & mask)) + break; + newattr = (newattr & ~mask) | (attr2 & mask); + cellmap[col0 + x].attr = newattr; + s[0] = cellmap[col0 + x].ch; + (cx, cy) := cellmap[col0 + x].clipmod; + f2 := cellmap[col0 + x].font; + + cellpos := Point(x * cellsize.x, y * cellsize.y); + clipr := Rect(cellpos, cellpos.add(Point(cellsize.x, cellsize.y))); + drawpt := cellpos.sub(Point(cx*cellsize.x, cy*cellsize.y)); + drawstr(s, f2, clipr, drawpt, newattr); + } + } + update <- = Continue; +} + +Scroll(topline, nlines : int) +{ + if (cellmap == nil || nlines == 0) + return; + + blankr : Rect; + scr := Rect((0,topline * cellsize.y), (ncols * cellsize.x, nrows * cellsize.y)); + + update <- = Pause; + + frames[0].clipr = scr; + frames[1].clipr = scr; + dstr := scr.subpt(Point(0, nlines * cellsize.y)); + + frames[0].draw(dstr, frames[0], nil, frames[0].clipr.min); + frames[1].draw(dstr, frames[1], nil, frames[1].clipr.min); + + if (nlines > 0) { + # scroll up - copy up from top + if (nlines > nrows - topline) + nlines = nrows - topline; + for (y := nlines + topline; y < nrows; y++) { + srccol0 := y * ncols; + dstcol0 := (y - nlines) * ncols; + cellmap[dstcol0:] = cellmap[srccol0:srccol0+ncols]; + } + for (y = nrows - nlines; y < nrows; y++) { + col0 := y * ncols; + cellmap[col0:] = blankrow; + } + blankr = Rect(Point(0, scr.max.y - (nlines * cellsize.y)), scr.max); + } else { + # scroll down - copy down from bottom + nlines = -nlines; + if (nlines > nrows - topline) + nlines = nrows - topline; + for (y := (nrows - 1) - nlines; y >= topline; y--) { + srccol0 := y * ncols; + dstcol0 := (y + nlines) * ncols; + cellmap[dstcol0:] = cellmap[srccol0:srccol0+ncols]; + } + for (y = topline; y < nlines; y++) { + col0 := y * ncols; + cellmap[col0:] = blankrow; + } + blankr = Rect(scr.min, (scr.max.x, scr.min.y + (nlines * cellsize.y))); + } + frames[0].draw(blankr, colours[0], nil, Point(0,0)); + frames[1].draw(blankr, colours[0], nil, Point(0,0)); + if (modbbox.dx() == 0) + modbbox = scr; + else + modbbox = boundingrect(modbbox, scr); + update <- = Continue; +} + +Reveal(show : int) +{ + showC = show; + if (cellmap == nil) + return; + + update <- = Pause; + for (y := 0; y < nrows; y++) { + col0 := y * ncols; + for (x := 0; x < ncols; x++) { + attr := cellmap[col0+x].attr; + if (!(attr & attrC)) + continue; + + s := ""; + s[0] = cellmap[col0 + x].ch; + (cx, cy) := cellmap[col0 + x].clipmod; + f := cellmap[col0 + x].font; + cellpos := Point(x * cellsize.x, y * cellsize.y); + clipr := Rect(cellpos, cellpos.add(Point(cellsize.x, cellsize.y))); + drawpt := cellpos.sub(Point(cx*cellsize.x, cy*cellsize.y)); + + drawstr(s, f, clipr, drawpt, attr); + } + } + update <- = Continue; +} + +# expects that pt.x already normalized +wordchar(pt : Point) : int +{ + if (pt.x < 0 || pt.x >= ncols) + return 0; + if (pt.y < 0 || pt.y >= nrows) + return 0; + + col0 := pt.y * ncols; + c := cellmap[col0 + pt.x]; + + if (c.attr & attrC && !showC) + # don't let clicking on screen 'reveal' concealed chars! + return 0; + + if (c.font == fontg1) + return 0; + + if (c.attr & attrW) { + # check for both parts of character + (modx, nil) := c.clipmod; + if (modx == 1) { + # rhs of char - check lhs is the same + if (pt.x <= 0) + return 0; + lhc := cellmap[col0 + pt.x-1]; + (lhmodx, nil) := lhc.clipmod; + if (!((lhc.attr & attrW) && (lhc.font == c.font) && (lhc.ch == c.ch) && (lhmodx == 0))) + return 0; + } else { + # lhs of char - check rhs is the same + if (pt.x >= ncols - 1) + return 0; + rhc := cellmap[col0 + pt.x + 1]; + (rhmodx, nil) := rhc.clipmod; + if (!((rhc.attr & attrW) && (rhc.font == c.font) && (rhc.ch == c.ch) && (rhmodx == 1))) + return 0; + } + } + if (c.ch >= 16r30 && c.ch <= 16r39) + # digits + return 1; + if (c.ch >= 16r41 && c.ch <= 16r5a) + # capitals + return 1; + if (c.ch >= 16r61 && c.ch <= 16r7a) + # lowercase + return 1; + if (c.ch == '*' || c.ch == '/') + return 1; + return 0; +} + +GetWord(gfxpt : Point) : string +{ + if (cellmap == nil) + return nil; + + scr := Rect((0,0), (ncols * cellsize.x, nrows * cellsize.y)); + gfxpt = gfxpt.sub(winoff); + + if (!gfxpt.in(scr)) + return nil; + + x := gfxpt.x / cellsize.x; + y := gfxpt.y / cellsize.y; + col0 := y * ncols; + + s := ""; + + # seek back + for (sx := x; sx >= 0; sx--) + if (!wordchar(Point(sx, y))) + break; + + if (sx++ == x) + return nil; + + # seek forward, constructing s + for (; sx < ncols; sx++) { + if (!wordchar(Point(sx, y))) + break; + c := cellmap[col0 + sx]; + s[len s] = c.ch; + if (c.attr & attrW) + sx++; + } + return s; +} + +Refresh() +{ + if (window == nil || modbbox.dx() == 0) + return; + + if (update != nil) + update <- = Redraw; +} + +framecolours(attr : int) : (ref Image, ref Image, ref Image, ref Image) +{ + fg : ref Image; + fgcol := attr & fgMask; + if (fgcol == fgWhite && attr & attrB) + fg = bright; + else + fg = colours[fgcol / fgBase]; + + bg : ref Image; + bgcol := attr & bgMask; + if (bgcol == bgWhite && attr & attrB) + bg = bright; + else + bg = colours[bgcol / bgBase]; + + (fg0, fg1) := (fg, fg); + (bg0, bg1) := (bg, bg); + + if (attr & attrP) + (fg0, bg0, fg1, bg1) = (bg1, fg1, bg0, fg0); + + if (attr & attrF) { + fg0 = fg; + fg1 = bg; + } + + if ((attr & attrC) && !showC) + (fg0, fg1) = (bg0, bg1); + return (fg0, bg0, fg1, bg1); +} + +kill(pid : int) +{ + prog := "/prog/" + string pid + "/ctl"; + fd := sys->open(prog, Sys->OWRITE); + if (fd != nil) { + cmd := array of byte "kill"; + sys->write(fd, cmd, len cmd); + } +} + +timer(ms : int, pc, tick : chan of int) +{ + pc <- = sys->pctl(0, nil); + for (;;) { + sys->sleep(ms); + tick <- = 1; + } +} + +# Update() commands +Redraw, Pause, Continue, CursorSet, QuitUpdate : con iota; + +Update(cmd : chan of int) +{ + flashtick := chan of int; + cursortick := chan of int; + pc := chan of int; + spawn timer(1000, pc, flashtick); + flashpid := <- pc; + spawn timer(500, pc, cursortick); + cursorpid := <- pc; + + cursor : Point; + showcursor := 0; + cursoron := 0; + quit := 0; + nultick := chan of int; + flashchan := nultick; + pcount := 1; + fgframe := 0; + + for (;!quit ;) alt { + c := <- cmd => + case c { + Redraw => + frames[0].clipr = frames[0].r; + frames[1].clipr = frames[1].r; + r := modbbox.addpt(winoff); + window.draw(r.addpt(window.r.min), frames[fgframe], nil, modbbox.min); + if (showcursor && cursoron) + drawcursor(cursor, fgframe, 1); + modbbox = Rect((0,0),(0,0)); + + Pause => + if (pcount++ == 0) + flashchan = nultick; + + Continue => + pcount--; + if (pcount == 0) + flashchan = flashtick; + + QuitUpdate => + quit++; + + CursorSet => + frames[0].clipr = frames[0].r; + frames[1].clipr = frames[1].r; + if (showcursor && cursoron) + drawcursor(cursor, fgframe, 0); + cursoron = 0; + if (curpos.x < 0 || curpos.x >= ncols || curpos.y < 0 || curpos.y >= nrows) + showcursor = 0; + else { + cursor = curpos; + showcursor = 1; + drawcursor(cursor, fgframe, 1); + cursoron = 1; + } + } + + <- flashchan => + # flip displays... + fgframe = (fgframe + 1 ) % 2; + modbbox = Rect((0,0),(0,0)); + frames[0].clipr = frames[0].r; + frames[1].clipr = frames[1].r; + window.draw(window.r.addpt(winoff), frames[fgframe], nil, Point(0,0)); + if (showcursor && cursoron) + drawcursor(cursor, fgframe, 1); + + <- cursortick => + if (showcursor) { + cursoron = !cursoron; + drawcursor(cursor, fgframe, cursoron); + } + } + kill(flashpid); + kill(cursorpid); +} + + +drawstr(s : string, f : ref Font, clipr : Rect, drawpt : Point, attr : int) +{ + (fg0, bg0, fg1, bg1) := framecolours(attr); + frames[0].clipr = clipr; + frames[1].clipr = clipr; + frames[0].draw(clipr, bg0, nil, Point(0,0)); + frames[1].draw(clipr, bg1, nil, Point(0,0)); + ulrect : Rect; + ul := (attr & attrL) && ! (attr & attrD); + + if (f != nil) { + if (ul) + ulrect = Rect((drawpt.x, drawpt.y + f.height - ulheight), (drawpt.x + clipr.dx(), drawpt.y + f.height)); + if (fg0 != bg0) { + frames[0].text(drawpt, fg0, Point(0,0), f, s); + if (ul) + frames[0].draw(ulrect, fg0, nil, Point(0,0)); + } + if (fg1 != bg1) { + frames[1].text(drawpt, fg1, Point(0,0), f, s); + if (ul) + frames[1].draw(ulrect, fg1, nil, Point(0,0)); + } + } + if (modbbox.dx() == 0) + modbbox = clipr; + else + modbbox = boundingrect(modbbox, clipr); +} + +boundingrect(r1, r2 : Rect) : Rect +{ + if (r2.min.x < r1.min.x) + r1.min.x = r2.min.x; + if (r2.min.y < r1.min.y) + r1.min.y = r2.min.y; + if (r2.max.x > r1.max.x) + r1.max.x = r2.max.x; + if (r2.max.y > r1.max.y) + r1.max.y = r2.max.y; + return r1; +} + +drawcursor(pt : Point, srcix, show : int) +{ + col0 := pt.y * ncols; + c := cellmap[col0 + pt.x]; + s := ""; + + s[0] = c.ch; + (cx, cy) := c.clipmod; + cellpos := Point(pt.x * cellsize.x, pt.y * cellsize.y); + clipr := Rect(cellpos, cellpos.add(Point(cellsize.x, cellsize.y))); + clipr = clipr.addpt(winoff); + clipr = clipr.addpt(window.r.min); + + drawpt := cellpos.sub(Point(cx*cellsize.x, cy*cellsize.y)); + drawpt = drawpt.add(winoff); + drawpt = drawpt.add(window.r.min); + + if (!show) { + # copy from appropriate frame buffer + window.draw(clipr, frames[srcix], nil, cellpos); + return; + } + + # invert colours + attr := c.attr ^ (fgMask | bgMask); + + fg, bg : ref Image; + f := c.font; + if (srcix == 0) + (fg, bg, nil, nil) = framecolours(attr); + else + (nil, nil, fg, bg) = framecolours(attr); + + prevclipr := window.clipr; + window.clipr = clipr; + + window.draw(clipr, bg, nil, Point(0,0)); + ulrect : Rect; + ul := (attr & attrL) && ! (attr & attrD); + + if (f != nil) { + if (ul) + ulrect = Rect((drawpt.x, drawpt.y + f.height - ulheight), (drawpt.x + clipr.dx(), drawpt.y + f.height)); + if (fg != bg) { + window.text(drawpt, fg, Point(0,0), f, s); + if (ul) + window.draw(ulrect, fg, nil, Point(0,0)); + } + } + window.clipr = prevclipr; +} diff --git a/appl/examples/minitel/mdisplay.m b/appl/examples/minitel/mdisplay.m new file mode 100644 index 00000000..24d7173f --- /dev/null +++ b/appl/examples/minitel/mdisplay.m @@ -0,0 +1,115 @@ +# +# Minitel display handling module +# +# © 1998 Vita Nuova Limited. All rights reserved. +# + +MDisplay: module +{ + + PATH: con "/dis/wm/minitel/mdisplay.dis"; + + # Available character sets + videotex, semigraphic, french, american : con iota; + + # Fill() attributes bit mask + # + # DL CFPH WBbb bfff + # + # D = Delimiter (set "serial" attributes for rest of line) + # L = Lining (underlined text & "separated" graphics) + # C = Concealing + # F = Flashing + # P = polarity (1 = "inverse") + # H = double height + # W = double width (set H+W for double size) + # B = bright (0: fgwhite=lt.grey, 1: fgwhite=white) + # bbb = background colour + # fff = foreground colour + + fgBase : con 8r001; + bgBase : con 8r010; + attrBase : con 8r100; + + fgMask : con 8r007; + bgMask : con 8r070; + attrMask : con ~0 ^ (fgMask | bgMask); + + fgBlack, fgBlue, fgRed, fgMagenta, + fgGreen, fgCyan, fgYellow, fgWhite : con iota * fgBase; + + bgBlack, bgBlue, bgRed, bgMagenta, + bgGreen, bgCyan, bgYellow, bgWhite : con iota * bgBase; + + attrB, attrW, attrH, attrP, attrF, attrC, attrL, attrD : con attrBase << iota; + + # + # Init (ctxt) : string + # performs general module initialisation + # creates the display window of size/position r using the + # given display context. + # spawns refresh thread + # returns reason for error, or nil on success + # + # Mode(rect, width, height, ulheight, delims, fontpath) : (string, ref Draw->Image) + # set/reset display to given rectangle and character grid size + # ulheight == underline height from bottom of character cell + # if delims != 0 then "field" attrs for Put() are derived from + # preceding delimiter otherwise Put() attrs are taken as is + # + # load fonts: + # videotex + # w videotex double width + # h videotex double height + # s videotex double size + # g1 videotex semigraphics + # fr french character set + # usa american character set + # Note: + # charset g2 is not directly supported, instead the symbols + # of g2 that do not appear in g0 (standard videotex charset) + # are available in videotex font using unicode char codes. + # Therefore controlling s/w must map g2 codes to unicode. + # + # Cursor(pt) + # move cursor to given position + # row number (y) is 0 based + # column number (x) is 1 based + # move cursor off-screen to hide + # + # Put(str, pt, charset, attr, insert) + # render string str at position pt in the given character set + # using specified attributes. + # if insert is non-zero, all characters from given position to end + # of line are moved right by len str positions. + # + # Scroll(topline, nlines) + # move the whole displayby nlines (+ve = scroll up). + # exposed lines of display are set to spaces rendered with + # the current mode attribute flags. + # scroll region is from topline to bottom of display + # + # Reveal(reveal) + # reveal/hide all chars affected by Concealing attribute. + # + # Refresh() + # force screen update + # + # GetWord(pt) : string + # returns on-screen word at given graphics co-ords + # returns nil if blank or semigraphic charset at location + # + # Quit() + # undo Init() + + + Init : fn (ctxt : ref Draw->Context) : string; + Mode : fn (r : Draw->Rect, width, height, ulh, attr : int, fontpath : string) : (string, ref Draw->Image); + Cursor : fn (pt : Draw->Point); + Put : fn (str : string, pt : Draw->Point, chset, attr, insert : int); + Scroll : fn (topline, nlines : int); + Reveal : fn (reveal : int); + Refresh : fn (); + GetWord : fn (gfxpt : Draw->Point) : string; + Quit : fn (); +}; diff --git a/appl/examples/minitel/miniterm.b b/appl/examples/minitel/miniterm.b new file mode 100644 index 00000000..1c6ff759 --- /dev/null +++ b/appl/examples/minitel/miniterm.b @@ -0,0 +1,1187 @@ +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +implement Miniterm; + +include "sys.m"; + sys: Sys; + print, fprint, sprint, read: import sys; +include "draw.m"; + draw: Draw; +include "tk.m"; + tk: Tk; +include "tkclient.m"; + tkclient: Tkclient; + +include "miniterm.m"; + +Miniterm: module +{ + init: fn(ctxt: ref Draw->Context, argv: list of string); + +}; + +pgrp: int = 0; +debug: array of int = array[256] of {* => 0}; +stderr: ref Sys->FD; + +# Minitel terminal identification request - reply sequence +TERMINALID1 := array [] of { + byte SOH, + byte 'S', byte 'X', byte '1', byte 'H', byte 'N', + byte EOT +}; +TERMINALID2 := array [] of { + byte SOH, + byte 'C', byte 'g', byte '1', + byte EOT +}; + +# Minitel module identifiers +Mscreen, Mmodem, Mkeyb, Msocket, Nmodule: con iota; +Pscreen, Pmodem, Pkeyb, Psocket: con (1 << iota); +Modname := array [Nmodule] of { + Mscreen => "S", + Mmodem => "M", + Mkeyb => "K", + Msocket => "C", + * => "?", +}; + +# attributes common to all modules +Module: adt { + path: int; # bitset to connected modules + disabled: int; +}; + +# A BufChan queues events from the terminal to the modules +BufChan: adt { + path: int; # id bit + ch: chan of ref Event; # set to `in' or `dummy' channel + ev: ref Event; # next event to send + in: chan of ref Event; # real channel for Events to the device + q: array of ref Event; # subsequent events to send +}; + +# holds state information for the minitel `protocol` (chapter 6) +PState: adt { + state: int; + arg: array of int; # up to 3 arguments: X,Y,Z + nargs: int; # expected number of arguments + n: int; # progress + skip: int; # transparency; bytes to skip +}; +PSstart, PSesc, PSarg: con iota; # states + +# Terminal display modes +Videotex, Mixed, Ascii, + +# Connection methods +Direct, Network, + +# Terminal connection states +Local, Connecting, Online, + +# Special features +Echo + : con (1 << iota); + +Terminal: adt { + in: chan of ref Event; + out: array of ref BufChan; # buffered output to the minitel modules + + mode: int; # display mode + state: int; # connection state + spec: int; # special features + connect: int; # Direct, or Network + toplevel: ref Tk->Toplevel; + cmd: chan of string; # from Tk + proto: array of ref PState; # minitel protocol state + netaddr: string; # network address to dial + buttonsleft: int; # display buttons on the LHS (40 cols) + terminalid: array of byte; # ENQROM response + kbctl: chan of string; # softkeyboard control + kbmode: string; # softkeyboard mode + + init: fn(t: self ref Terminal, toplevel: ref Tk->Toplevel, connect: int); + run: fn(t: self ref Terminal, done: chan of int); + reset: fn(t: self ref Terminal); + quit: fn(t: self ref Terminal); + layout: fn(t: self ref Terminal, cols: int); + setkbmode: fn(t: self ref Terminal, tmode: int); +}; + +include "arg.m"; +include "event.m"; +include "event.b"; + +include "keyb.b"; +include "modem.b"; +include "socket.b"; +include "screen.b"; + +K: ref Keyb; +M: ref Modem; +C: ref Socket; +S: ref Screen; +T: ref Terminal; +Modules: array of ref Module; + + +init(ctxt: ref Draw->Context, argv: list of string) +{ + s: string; + netaddr: string = nil; + + sys = load Sys Sys->PATH; + tk = load Tk Tk->PATH; + tkclient = load Tkclient Tkclient->PATH; + tkclient->init(); + draw = load Draw Draw->PATH; + stderr = sys->fildes(2); + pgrp = sys->pctl(Sys->NEWPGRP|Sys->FORKNS, nil); + + arg := load Arg Arg->PATH; + arg->init(argv); + arg->setusage("miniterm [netaddr]"); + while((c := arg->opt()) != 0){ + case c { + 'D' => + s = arg->earg(); + for(i := 0; i < len s; i++){ + c = s[i]; + if(c < len debug) + debug[c] += 1; + } + * => + arg->usage(); + } + } + argv = arg->argv(); + if(len argv > 0) { + netaddr = hd argv; + argv = tl argv; + } + + if(argv != nil) + arg->usage(); + arg = nil; + + # usage: miniterm modem[!init[!number]] + # or miniterm tcp!a.b.c.d + connect: int; + initstr := dialstr := string nil; + if(netaddr == nil) + netaddr = "tcp!pdc.minitelfr.com!513"; # gateway + (nil, words) := sys->tokenize(netaddr, "!"); + if(len words == 0) { + connect = Direct; + words = "modem" :: nil; + } + if(hd words == "modem") { + connect = Direct; + words = tl words; + if(words != nil) { + initstr = hd words; + words = tl words; + if(words != nil) + dialstr = hd words; + } + if(initstr == "*") + initstr = nil; + if(dialstr == "*") + dialstr = nil; + } else { + connect = Network; + dialstr = netaddr; + } + + T = ref Terminal; + K = ref Keyb; + M = ref Modem; + C = ref Socket; + S = ref Screen; + Modules = array [Nmodule] of { + Mscreen => S.m, + Mmodem => M.m, + Mkeyb => K.m, + Msocket => C.m, + }; + + toplevel := tk->toplevel(ctxt.display, ""); + inittk(toplevel, connect); + + T.init(toplevel, connect); + K.init(toplevel); + M.init(connect, initstr, dialstr); + C.init(); + case connect { + Direct => + S.init(ctxt, Rect((0,0), (640,425)), Rect((0,0), (640,425))); + Network => + S.init(ctxt, Rect((0,0), (596,440)), Rect((0,50), (640,350))); + } + + done := chan of int; + spawn K.run(); + spawn M.run(); + spawn C.run(); + spawn S.run(); + spawn T.run(done); + <- done; + + # now tidy up + K.quit(); + M.quit(); + C.quit(); + S.quit(); + T.quit(); +} + +# the keyboard module handles keypresses and focus +BTN40x25: con "-height 24 -font {/fonts/lucidasans/unicode.6.font}"; +BTNCTL: con "-width 60 -height 20 -font {/fonts/lucidasans/unicode.7.font}"; +BTNMAIN: con "-width 80 -height 20 -font {/fonts/lucidasans/unicode.7.font}"; + +tkinitbs := array[] of { + "button .cxfin -text {Cx/Fin} -command {send keyb skey Connect}", + "button .done -text {Quitter} -command {send keyb skey Exit}", + "button .hup -text {Raccr.} -command {send term hangup}", + "button .somm -text {Somm.} -command {send keyb skey Index}", + "button .guide -text {Guide} -command {send keyb skey Guide}", + "button .annul -text {Annul.} -command {send keyb skey Cancel}", + "button .corr -text {Corr.} -command {send keyb skey Correct}", + "button .retour -text {Retour} -command {send keyb skey Previous}", + "button .suite -text {Suite} -command {send keyb skey Next}", + "button .repet -text {Répét.} -command {send keyb skey Repeat}", + "button .envoi -text {Envoi} -command {send keyb skey Send}", + "button .play -text {P} -command {send term play}", +# "button .db -text {D} -command {send term debug}" , + "button .kb -text {Clavier} -command {send term keyboard}", + "button .move -text {<-} -command {send term buttonsleft} " + BTN40x25, +}; + +tkinitdirect := array [] of { + ". configure -background black -height 480 -width 640", + + ".cxfin configure " + BTNCTL, + ".hup configure " + BTNCTL, + ".done configure " + BTNCTL, + ".somm configure " + BTNMAIN, + ".guide configure " + BTNMAIN, + ".annul configure " + BTNMAIN, + ".corr configure " + BTNMAIN, + ".retour configure " + BTNMAIN, + ".suite configure " + BTNMAIN, + ".repet configure " + BTNMAIN, + ".envoi configure " + BTNMAIN, +# ".play configure " + BTNCTL, +# ".db configure " + BTNCTL, + ".kb configure " + BTNCTL, + + "canvas .c -height 425 -width 640 -background black", + "bind .c {send term resize}", + "bind .c {send keyb key %K}", + "bind .c {send keyb focusin}", + "bind .c {send keyb focusout}", + "bind .c {focus .c; send keyb click %x %y}", + "frame .k -height 55 -width 640 -background black", + "pack propagate .k no", + "frame .klhs -background black", + "frame .krhs -background black", + "frame .krows -background black", + "frame .k1 -background black", + "frame .k2 -background black", + "pack .cxfin -in .klhs -anchor w -pady 4", + "pack .hup -in .klhs -anchor w", + "pack .somm .annul .retour .repet -in .k1 -side left -padx 2", + "pack .guide .corr .suite .envoi -in .k2 -side left -padx 2", + "pack .kb -in .krhs -anchor e -pady 4", + "pack .done -in .krhs -anchor e", + "pack .k1 -in .krows -pady 4", + "pack .k2 -in .krows", + "pack .klhs .krows .krhs -in .k -side left -expand 1 -fill x", + "pack .c .k", + "focus .c", + "update", +}; + +tkinitip := array [] of { + ". configure -background black -height 440 -width 640", + + # ip 40x25 mode support + "canvas .c40 -height 440 -width 596 -background black", + "bind .c40 {send term resize}", + "bind .c40 {send keyb key %K}", + "bind .c40 {send keyb focusin}", + "bind .c40 {send keyb focusout}", + "bind .c40 {focus .c40; send keyb click %x %y}", + "frame .k -height 427 -width 44 -background black", + "frame .gap1 -background black", + "frame .gap2 -background black", + "pack propagate .k no", + + # ip 80x25 mode support + "frame .padtop -height 50", + "canvas .c80 -height 300 -width 640 -background black", + "bind .c80 {send term resize}", + "bind .c80 {send keyb key %K}", + "bind .c80 {send keyb focusin}", + "bind .c80 {send keyb focusout}", + "bind .c80 {focus .c80; send keyb click %x %y}", + "frame .k80 -height 90 -width 640 -background black", + "pack propagate .k80 no", + "frame .klhs -background black", + "frame .krows -background black", + "frame .krow1 -background black", + "frame .krow2 -background black", + "frame .krhs -background black", + "pack .krow1 .krow2 -in .krows -pady 2", + "pack .klhs -in .k80 -side left", + "pack .krows -in .k80 -side left -expand 1", + "pack .krhs -in .k80 -side left", +}; + +tkip40x25show := array [] of { + ".cxfin configure " + BTN40x25, + ".hup configure " + BTN40x25, + ".done configure " + BTN40x25, + ".somm configure " + BTN40x25, + ".guide configure " + BTN40x25, + ".annul configure " + BTN40x25, + ".corr configure " + BTN40x25, + ".retour configure " + BTN40x25, + ".suite configure " + BTN40x25, + ".repet configure " + BTN40x25, + ".envoi configure " + BTN40x25, + ".play configure " + BTN40x25, +# ".db configure " + BTN40x25, + ".kb configure " + BTN40x25, + "pack .cxfin -in .k -side top -fill x", + "pack .gap1 -in .k -side top -expand 1", + "pack .guide .repet .somm .annul .corr .retour .suite .envoi -in .k -side top -fill x", + "pack .gap2 -in .k -side top -expand 1", + "pack .done .hup .kb .move -in .k -side bottom -pady 2 -fill x", +# "pack .db -in .k -side bottom", +}; + +tkip40x25lhs := array [] of { + ".move configure -text {->} -command {send term buttonsright}", + "pack .k .c40 -side left", + "focus .c40", + "update", +}; + +tkip40x25rhs := array [] of { + ".move configure -text {<-} -command {send term buttonsleft}", + "pack .c40 .k -side left", + "focus .c40", + "update", +}; + +tkip40x25hide := array [] of { + "pack forget .k .c40", +}; + +tkip80x25show := array [] of { + ".cxfin configure " + BTNCTL, + ".hup configure " + BTNCTL, + ".done configure " + BTNCTL, + ".somm configure " + BTNMAIN, + ".guide configure " + BTNMAIN, + ".annul configure " + BTNMAIN, + ".corr configure " + BTNMAIN, + ".retour configure " + BTNMAIN, + ".suite configure " + BTNMAIN, + ".repet configure " + BTNMAIN, + ".envoi configure " + BTNMAIN, +# ".play configure " + BTNCTL, +# ".db configure " + BTNCTL, + ".kb configure " + BTNCTL, + + "pack .cxfin .hup -in .klhs -anchor w -pady 2", + "pack .somm .annul .retour .repet -in .krow1 -side left -padx 2", + "pack .guide .corr .suite .envoi -in .krow2 -side left -padx 2", + "pack .done .kb -in .krhs -anchor e -pady 2", + "pack .padtop .c80 .k80 -side top", + "focus .c80", + "update", +}; + +tkip80x25hide := array [] of { + "pack forget .padtop .c80 .k80", +}; + +inittk(toplevel: ref Tk->Toplevel, connect: int) +{ + tkcmds(toplevel, tkinitbs); + if(connect == Direct) + tkcmds(toplevel, tkinitdirect); + else + tkcmds(toplevel, tkinitip); +} + +Terminal.layout(t: self ref Terminal, cols: int) +{ + if(t.connect == Direct) + return; + if(cols == 80) { + tkcmds(t.toplevel, tkip40x25hide); + tkcmds(t.toplevel, tkip80x25show); + } else { + tkcmds(t.toplevel, tkip80x25hide); + tkcmds(t.toplevel, tkip40x25show); + if (t.buttonsleft) + tkcmds(t.toplevel, tkip40x25lhs); + else + tkcmds(t.toplevel, tkip40x25rhs); + } +} + +Terminal.init(t: self ref Terminal, toplevel: ref Tk->Toplevel, connect: int) +{ + t.in = chan of ref Event; + t.proto = array [Nmodule] of { + Mscreen => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), + Mmodem => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), + Mkeyb => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), + Msocket => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), + }; + + t.toplevel = toplevel; + t.connect = connect; + if (t.connect == Direct) + t.spec = 0; + else + t.spec = Echo; + t.cmd = chan of string; + tk->namechan(t.toplevel, t.cmd, "term"); # Tk -> terminal + t.state = Local; + t.buttonsleft = 0; + t.kbctl = nil; + t.kbmode = "minitel"; + t.reset(); +} + +Terminal.reset(t: self ref Terminal) +{ + t.mode = Videotex; +} + +Terminal.run(t: self ref Terminal, done: chan of int) +{ + t.out = array [Nmodule] of { + Mscreen => ref BufChan(Pscreen, nil, nil, S.in, array [0] of ref Event), + Mmodem => ref BufChan(Pmodem, nil, nil, M.in, array [0] of ref Event), + Mkeyb => ref BufChan(Pkeyb, nil, nil, K.in, array [0] of ref Event), + Msocket => ref BufChan(Psocket, nil, nil, C.in, array [0] of ref Event), + }; + modcount := Nmodule; + if(debug['P']) + post(ref Event.Eproto(Pmodem, 0, Cplay, "play", 0,0,0)); +Evloop: + for(;;) { + ev: ref Event = nil; + post(nil); + alt { + # recv message from one of the modules + ev =<- t.in => + if(ev == nil) { # modules ack Equit with nil + if(--modcount == 0) + break Evloop; + continue; + } + pick e := ev { + Equit => # close modules down + post(ref Event.Equit(Pscreen|Pmodem|Pkeyb|Psocket,0)); + continue; + } + + eva := protocol(ev); + while(len eva > 0) { + post(eva[0]); + eva = eva[1:]; + } + + # send message to `plumbed' modules + t.out[Mscreen].ch <- = t.out[Mscreen].ev => + t.out[Mscreen].ev = nil; + t.out[Mmodem].ch <- = t.out[Mmodem].ev => + t.out[Mmodem].ev = nil; + t.out[Mkeyb].ch <- = t.out[Mkeyb].ev => + t.out[Mkeyb].ev = nil; + t.out[Msocket].ch <- = t.out[Msocket].ev => + t.out[Msocket].ev = nil; + + # recv message from Tk + cmd := <- t.cmd => + (n, word) := sys->tokenize(cmd, " "); + if(n >0) + case hd word { + "resize" => ; + "play" => # for testing only + post(ref Event.Eproto(Pmodem, Mmodem, Cplay, "play", 0,0,0)); + "keyboard" => + if (t.kbctl == nil) { + e: string; + (e, t.kbctl) = kb(t); + if (e != nil) + sys->print("cannot start keyboard: %s\n", e); + } else + t.kbctl <- = "click"; + "hangup" => + if(T.state == Online || T.state == Connecting) + post(ref Event.Eproto(Pmodem, 0, Cdisconnect, "",0,0,0)); + "buttonsleft" => + tkcmds(t.toplevel, tkip40x25lhs); + t.buttonsleft = 1; + if(S.image != nil) + draw->(S.image.origin)(Point(0,0), Point(44, 0)); + if (t.kbctl != nil) + t.kbctl <- = "fg"; + "buttonsright" => + tkcmds(t.toplevel, tkip40x25rhs); + t.buttonsleft = 0; + if(S.image != nil) + draw->(S.image.origin)(Point(0,0), Point(0, 0)); + if (t.kbctl != nil) + t.kbctl <- = "fg"; + "debug" => + debug['s'] ^= 1; + debug['m'] ^= 1; + } + } + + } + if (t.kbctl != nil) + t.kbctl <- = "quit"; + t.kbctl = nil; + done <-= 0; +} + +kb(t: ref Terminal): (string, chan of string) +{ + s := chan of string; + spawn dokb(t, s); + e := <- s; + if (e != nil) + return (e, nil); + return (nil, s); +} + +Terminal.setkbmode(t: self ref Terminal, tmode: int) +{ + case tmode { + Videotex => + t.kbmode = "minitel"; + Mixed or Ascii => + t.kbmode = "standard"; + } + if(t.kbctl != nil) { + t.kbctl <-= "mode"; + t.kbctl <-= "fg"; + } +} + +include "swkeyb.m"; +dokb(t: ref Terminal, c: chan of string) +{ + keyboard := load Keyboard Keyboard->PATH; + if (keyboard == nil) { + c <- = "cannot load keyboard"; + return; + } + + kbctl := chan of string; + (top, m) := tkclient->toplevel(S.ctxt, "", "Keyboard", 0); + tk->cmd(top, "pack .Wm_t -fill x"); + tk->cmd(top, "update"); + keyboard->chaninit(top, S.ctxt, ".keys", kbctl); + tk->cmd(top, "pack .keys"); + + kbctl <-= t.kbmode ; + + kbon := 1; + c <- = nil; # all ok, we are now ready to accept commands + + for (;;) alt { + mcmd := <- m => + if (mcmd == "exit") { + if (kbon) { + tk->cmd(top, ". unmap; update"); + kbon = 0; + } + } else + tkclient->wmctl(top, mcmd); + kbcmd := <- c => + case kbcmd { + "fg" => + if (kbon) + tk->cmd(top, "raise .;update"); + "click" => + if (kbon) { + tk->cmd(top, ". unmap; update"); + kbon = 0; + } else { + tk->cmd(top, ". map; raise ."); + kbon = 1; + } + "mode" => + kbctl <- = t.kbmode; + "quit" => + kbctl <- = "kill"; + top = nil; + # ensure tkclient not blocked on a send to us (probably overkill!) + alt { + <- m => ; + * => ; + } + return; + } + } +} + + +Terminal.quit(nil: self ref Terminal) +{ +} + +# a minitel module sends an event to the terminal for routing +send(e: ref Event) +{ + if(debug['e'] && e != nil) + fprint(stderr, "%s: -> %s\n", Modname[e.from], e.str()); + T.in <- = e; +} + +# post an event to one or more modules +post(e: ref Event) +{ + i,l: int; + for(i=0; i 0) { + pick de := e { + * => + fprint(stderr, "[%s<-%s] %s\n", Modname[i], Modname[e.from], e.str()); + } + } + if(b.ev == nil) # nothing queued + b.ev = e; + else { # enqueue it + l = len b.q; + na := array [l+1] of ref Event; + na[0:] = b.q[0:]; + na[l] = e; + b.q = na; + } + } + } + # set a dummy channel if nothing to send + if(b.ev == nil) + b.ch = chan of ref Event; + else + b.ch = b.in; + } +} + +# run the terminal protocol +protocol(ev: ref Event): array of ref Event +{ + # Introduced by the following sequences, the minitel protocol can be + # embedded in any normal data sequence + # ESC,0x39,X + # ESC,0x3a,X,Y + # ESC,0x3b,X,Y,Z + # ESC,0x61 - cursor position request + + ea := array [0] of ref Event; # resulting sequence of Events + changed := 0; # if set, results are found in `ea' + + pick e := ev { + Edata => + d0 := 0; # offset of start of last data sequence + p := T.proto[e.from]; + for(i:=0; i 0) { # in transparency mode + if(ch == 0 && e.from == Mmodem) # 5.0 + continue; + p.skip--; + continue; + } + case p.state { + PSstart => + if(ch == ESC) { + p.state = PSesc; + changed = 1; + if(i > d0) + ea = eappend(ea, ref Event.Edata(e.path, e.from, e.data[d0:i])); + d0 = i+1; + } + PSesc => + p.state = PSarg; + p.n = 0; + d0 = i+1; + changed = 1; + if(ch >= 16r39 && ch <= 16r3b) #PRO1,2,3 + p.nargs = ch - 16r39 + 1; + else if(ch == 16r61) # cursor position request + p.nargs = 0; + else if(ch == ESC) { + ea = eappend(ea, ref Event.Edata(e.path, e.from, array [] of { byte ESC })); + p.state = PSesc; + } else { + # false alarm, restore as data + ea = eappend(ea, ref Event.Edata(e.path, e.from, array [] of { byte ESC, byte ch })); + p.state = PSstart; + } + PSarg => # expect `nargs' bytes + d0 = i+1; + changed =1; + if(p.n < p.nargs) + p.arg[p.n++] = ch; + if(p.n == p.nargs) { + # got complete protocol sequence + pe := proto(e.from, p); + if(pe != nil) + ea = eappend(ea, pe); + p.state = PSstart; + } + } + } + if(changed) { # some interpretation, results in `ea' + if(i > d0) + ea = eappend(ea, ref Event.Edata(e.path, e.from, e.data[d0:i])); + return ea; + } + ev = e; + return array [] of {ev}; + } + return array [] of {ev}; +} + +# append to an Event array +eappend(ea: array of ref Event, e: ref Event): array of ref Event +{ + l := len ea; + na := array [l+1] of ref Event; + na[0:] = ea[0:]; + na[l] = e; + return na; +} + +# act on a received protocol sequence +# some sequences are handled here by the terminal and result in a posted reply +# others are returned `inline' as Eproto events with the normal data stream. +proto(from: int, p: ref PState): ref Event +{ + if(debug['p']) { + fprint(stderr, "PRO%d: %ux", p.nargs, p.arg[0]); + if(p.nargs > 1) + fprint(stderr, " %ux", p.arg[1]); + if(p.nargs > 2) + fprint(stderr, " %ux", p.arg[2]); + fprint(stderr, " (%s)\n", Modname[from]); + } + case p.nargs { + 0 => # cursor position request ESC 0x61 + reply := array [] of { byte US, byte S.pos.y, byte S.pos.x }; + post(ref Event.Edata(Pmodem, from, reply)); + 1 => + case p.arg[0] { + PROTOCOLSTATUS => ; + ENQROM => # identification request + post(ref Event.Edata(Pmodem, from, T.terminalid)); + if(T.terminalid == TERMINALID1) + T.terminalid = TERMINALID2; + SETRAM1 or SETRAM2 => ; + FUNCTIONINGSTATUS => # 11.3 + PRO2(Pmodem, from, REPFUNCTIONINGSTATUS, osb()); + CONNECT => ; + DISCONNECT => + return ref Event.Eproto(Pscreen, from, Cscreenoff, "",0,0,0); + RESET => # reset the minitel terminal + all := Pscreen|Pmodem|Pkeyb|Psocket; + post(ref Event.Eproto(all, from, Creset, "",0,0,0)); # check + T.reset(); + reply := array [] of { byte SEP, byte 16r5E }; + post(ref Event.Edata(Pmodem, from, reply)); + } + 2 => + case p.arg[0] { + TO => # request for module status + PRO3(Pmodem, from, FROM, p.arg[1], psb(p.arg[1])); + NOBROADCAST => ; + BROADCAST => ; + TRANSPARENCY => # transparency mode - skip bytes + p.skip = p.arg[1]; + if(p.skip < 1 || p.skip > 127) # 5.0 + p.skip = 0; + else { + reply := array [] of { byte SEP, byte 16r57 }; + post(ref Event.Edata(Pmodem, from, reply)); + } + KEYBOARDSTATUS => + if(p.arg[1] == RxKeyb) + PRO3(Pmodem, from, REPKEYBOARDSTATUS, RxKeyb, kosb()); + START => + x := osb(); + if(p.arg[1] == PROCEDURE) + x |= 16r04; + if(p.arg[1] == SCROLLING) + x |= 16r02; + PRO2(Pmodem, from, REPFUNCTIONINGSTATUS, x); + case p.arg[1] { + PROCEDURE => # activate error correction procedure + sys->print("activate error correction\n"); + return ref Event.Eproto(Pmodem, from, Cstartecp, "",0,0,0); + SCROLLING => # set screen to scroll + return ref Event.Eproto(Pscreen, from, Cproto, "",START,SCROLLING,0); + LOWERCASE => # set keyb to invert case + return ref Event.Eproto(Pkeyb, from, Cproto, "",START,LOWERCASE,0); + } + STOP => + x := osb(); + if(p.arg[1] == SCROLLING) + x &= ~16r02; + PRO2(Pmodem, from, REPFUNCTIONINGSTATUS, osb()); + case p.arg[1] { + PROCEDURE => # deactivate error correction procedure + sys->print("deactivate error correction\n"); + return ref Event.Eproto(Pmodem, from, Cstopecp, "",0,0,0); + SCROLLING => # set screen to no scroll + return ref Event.Eproto(Pscreen, from, Cproto, "",STOP,SCROLLING,0); + LOWERCASE => # set keyb to not invert case + return ref Event.Eproto(Pkeyb, from, Cproto, "",STOP,LOWERCASE,0); + } + COPY => # copy screen to socket + # not implemented + ; + MIXED => # change video mode (12.1) + case p.arg[1] { + MIXED1 => # videotex -> mixed + reply := array [] of { byte SEP, byte 16r70 }; + return ref Event.Eproto(Pscreen, from, Cproto, "",MIXED,MIXED1,0); + MIXED2 => # mixed -> videotex + reply := array [] of { byte SEP, byte 16r71 }; + return ref Event.Eproto(Pscreen, from, Cproto, "",MIXED,MIXED2,0); + } + ASCII => # change video mode (12.2) + # TODO + ; + } + 3 => + case p.arg[0] { + OFF or ON => # link, unlink, enable, disable + modcmd(p.arg[0], p.arg[1], p.arg[2]); + PRO3(Pmodem, from, FROM, p.arg[1], psb(TxCode(p.arg[1]))); + START => + case p.arg[1] { + RxKeyb => # keyboard mode + case p.arg[2] { + ETEN => # extended keyboard + K.spec |= Extend; + C0 => # cursor control key coding from col 0 + K.spec |= C0keys; + } + PRO3(Pmodem, from, REPKEYBOARDSTATUS, RxKeyb, kosb()); + } + STOP => # keyboard mode + case p.arg[1] { + RxKeyb => # keyboard mode + case p.arg[2] { + ETEN => # extended keyboard + K.spec &= ~Extend; + C0 => # cursor control key coding from col 0 + K.spec &= ~C0keys; + } + PRO3(Pmodem, from, REPKEYBOARDSTATUS, RxKeyb, kosb()); + } + } + } + return nil; +} + +# post a PRO3 sequence to all modules on `path' +PRO3(path, from, x, y, z: int) +{ + data := array [] of { byte ESC, byte 16r3b, byte x, byte y, byte z}; + post(ref Event.Edata(path, from, data)); +} + +# post a PRO2 sequence to all modules on `path' +PRO2(path, from, x, y: int) +{ + data := array [] of { byte ESC, byte 16r3a, byte x, byte y}; + post(ref Event.Edata(path, from, data)); +} + +# post a PRO1 sequence to all modules on `path' +PRO1(path, from, x: int) +{ + data := array [] of { byte ESC, byte 16r39, byte x}; + post(ref Event.Edata(path, from, data)); +} + +# make or break links between modules, or enable and disable +modcmd(cmd, from, targ: int) +{ + from = RxTx(from); + targ = RxTx(targ); + if(from == targ) # enable or disable module + if(cmd == ON) + Modules[from].disabled = 0; + else + Modules[from].disabled = 1; + else # modify path + if(cmd == ON) + Modules[from].path |= (1< 0) { + if(b&1) + p ^= 1; + b >>= 1; + } + return p; +} + +# convert Rx or Tx code to a module code +RxTx(code: int): int +{ + rv := 0; + case code { + TxScreen or RxScreen => rv = Mscreen; + TxKeyb or RxKeyb => rv = Mkeyb; + TxModem or RxModem => rv = Mmodem; + TxSocket or RxSocket => rv = Msocket; + * => + fatal("invalid module code"); + } + return rv; +} + +# generate an operating status byte (11.2) +osb(): int +{ + b := 16r40; + if(S.cols == 80) + b |= 16r01; + if(S.spec & Scroll) + b |= 16r02; + if(M.spec & Ecp) + b |= 16r04; + if(K.spec & Invert) + b |= 16r08; +# if(parity(b)) +# b ^= 16r80; + return b; +} + +# generate a keyboard operating status byte (9.1.2) +kosb(): int +{ + b := 16r40; + if(K.spec & Extend) + b |= 16r01; + if(K.spec & C0keys) + b |= 16r04; +# if(parity(b)) +# b ^= 16r80; + return b; +} + +hex(v, n: int): string +{ + return sprint("%.*ux", n, v); +} + +tostr(ch: int): string +{ + str := ""; + str[0] = ch; + return str; +} + +toint(s: string, base: int): (int, string) +{ + if(base < 0 || base > 36) + return (0, s); + + c := 0; + for(i := 0; i < len s; i++) { + c = s[i]; + if(c != ' ' && c != '\t' && c != '\n') + break; + } + + neg := 0; + if(c == '+' || c == '-') { + if(c == '-') + neg = 1; + i++; + } + + ok := 0; + n := 0; + for(; i < len s; i++) { + c = s[i]; + v := base; + case c { + 'a' to 'z' => + v = c - 'a' + 10; + 'A' to 'Z' => + v = c - 'A' + 10; + '0' to '9' => + v = c - '0'; + } + if(v >= base) + break; + ok = 1; + n = n * base + v; + } + + if(!ok) + return (0, s); + if(neg) + n = -n; + return (n, s[i:]); +} + +tolower(s: string): string +{ + r := s; + for(i := 0; i < len r; i++) { + c := r[i]; + if(c >= int 'A' && c <= int 'Z') + r[i] = r[i] + (int 'a' - int 'A'); + } + return r; +} + +# duplicate `ch' exactly `n' times +dup(ch, n: int): string +{ + str := ""; + for(i:=0; iopen("#p/" + string pgrp + "/ctl", sys->OWRITE); + if(fd != nil) + sys->fprint(fd, "killgrp"); + exit; +} + +# Minitel byte MSB and LSB classification (p.87) +MSB(ch: int): int +{ + return (ch&16r70)>>4; +} +LSB(ch: int): int +{ + return (ch&16r0f); +} + +# Minitel character set classification (p.92) +ISC0(ch: int): int +{ + msb := (ch&16r70)>>4; + return msb == 0 || msb == 1; +} + +ISC1(ch: int): int +{ + return ch >= 16r40 && ch <= 16r5f; +} + +ISG0(ch: int): int +{ + # 0x20 (space) and 0x7f (DEL) are not in G0 + return ch > 16r20 && ch < 16r7f; +} + +tkcmds(t: ref Tk->Toplevel, cmds: array of string) +{ + n := len cmds; + for (ix := 0; ix < n; ix++) + tk->cmd(t, cmds[ix]); +} diff --git a/appl/examples/minitel/miniterm.m b/appl/examples/minitel/miniterm.m new file mode 100644 index 00000000..e0345f81 --- /dev/null +++ b/appl/examples/minitel/miniterm.m @@ -0,0 +1,120 @@ +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +# Common control bytes +NUL: con 16r00; +SOH: con 16r01; +EOT: con 16r04; +ENQ: con 16r05; +BEL: con 16r07; +BS: con 16r08; +HT: con 16r09; +LF: con 16r0a; +VT: con 16r0b; +FF: con 16r0c; +CR: con 16r0d; +SO: con 16r0e; +SI: con 16r0f; +DLE: con 16r10; +CON: con 16r11; +XON: con 16r11; +REP: con 16r12; +SEP: con 16r13; +XOFF: con 16r13; +COFF: con 16r14; +NACK: con 16r15; +SYN: con 16r16; +CAN: con 16r18; +SS2: con 16r19; +SUB: con 16r1a; +ESC: con 16r1b; +SS3: con 16r1d; +RS: con 16r1e; +US: con 16r1f; + +SP: con 16r20; +DEL: con 16r7f; + +# Minitel Protocol - some are duplicated (chapter 6) +ASCII: con 16r31; +MIXED: con 16r32; +ETEN: con 16r41; +C0: con 16r43; +SCROLLING: con 16r43; +PROCEDURE: con 16r44; +LOWERCASE: con 16r45; +OFF: con 16r60; +ON: con 16r61; +TO: con 16r62; +FROM: con 16r63; +NOBROADCAST: con 16r64; +BROADCAST: con 16r65; +NONRETURN: con 16r64; +RETURN: con 16r65; +TRANSPARENCY: con 16r66; +DISCONNECT: con 16r67; +CONNECT: con 16r68; +START: con 16r69; +STOP: con 16r6a; +KEYBOARDSTATUS: con 16r72; +REPKEYBOARDSTATUS: con 16r73; +FUNCTIONINGSTATUS: con 16r72; +REPFUNCTIONINGSTATUS: con 16r73; +EXCHANGERATESTATUS: con 16r74; +REPEXCHANGERATESTATUS: con 16r75; +PROTOCOLSTATUS: con 16r76; +REPPROTOCOLSTATUS: con 16r77; +SETRAM1: con 16r78; +SETRAM2: con 16r79; +ENQROM: con 16r7b; +COPY: con 16r7c; +ASCII1: con 16r7d; +MIXED1: con 16r7d; +MIXED2: con 16r7e; +RESET: con 16r7f; + +# Module send and receive codes (chapter 6) +TxScreen: con 16r50; +TxKeyb: con 16r51; +TxModem: con 16r52; +TxSocket: con 16r53; +RxScreen: con 16r58; +RxKeyb: con 16r59; +RxModem: con 16r5a; +RxSocket: con 16r5b; + +# Internal Event.Eproto command constants +Cplay, # for testing +Cconnect, # e.s contains the address to dial +Cdisconnect, # +Crequestecp, # ask server to start ecp +Creset, # reset module +Cstartecp, # start error correction +Cstopecp, # stop error correction +Cproto, # minitel protocol +Ccursor, # update screen cursor +Cindicators, # update row 0 indicators + +# softmodem bug: Cscreenoff, Cscreenon +Cscreenoff, # screen: ignore data +Cscreenon, # screen: don't ignore data + +Clast + : con iota; + +# Special keys - hardware returned byte +KupPC: con 16r0203; # pc emu +KdownPC: con 16r0204; # pc emu +Kup: con 16rE012; +Kdown: con 16rE013; +Kenter: con 16r000a; +Kback: con 16r0008; +Kesc: con 16r001b; +KF1: con 16rE041; +KF2: con 16rE042; +KF3: con 16rE043; +KF4: con 16rE044; +KF13: con 16rE04D; + + diff --git a/appl/examples/minitel/mkfile b/appl/examples/minitel/mkfile new file mode 100644 index 00000000..16f816a6 --- /dev/null +++ b/appl/examples/minitel/mkfile @@ -0,0 +1,24 @@ +<../../../mkconfig + +TARG=\ + mdisplay.dis\ + miniterm.dis\ + swkeyb.dis\ + +MODULES=\ + mdisplay.m\ + miniterm.m\ + event.m\ + swkeyb.m\ + +SYSMODULES=\ + arg.m\ + sys.m\ + debug.m\ + draw.m\ + tk.m\ + wmlib.m\ + +DISBIN=$ROOT/dis/wm/minitel + +<$ROOT/mkfiles/mkdis diff --git a/appl/examples/minitel/modem.b b/appl/examples/minitel/modem.b new file mode 100644 index 00000000..b7a21c1d --- /dev/null +++ b/appl/examples/minitel/modem.b @@ -0,0 +1,620 @@ +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +#modem states for direct connection +MSstart, MSdialing, MSconnected, MSdisconnecting, + +# special features +Ecp # error correction + : con (1 << iota); + +Ecplen: con 17; # error correction block length: data[15], crc, validation (=0) + +Modem: adt { + m: ref Module; # common attributes + in: chan of ref Event; + + connect: int; # None, Direct, Network + state: int; # modem dialing state + saved: string; # response, so far (direct dial) + initstr: string; # softmodem init string (direct dial) + dialstr: string; # softmodem dial string (direct dial) + lastdialstr: string; + + spec: int; # special features + fd: ref Sys->FD; # modem data file, if != nil + cfd: ref Sys->FD; # modem ctl file, if != nil (direct dial only) + devpath: string; # path to the modem; + avail: array of byte; # already read + rd: chan of array of byte; # reader -> rd + pid: int; # reader pid if != 0 + + seq: int; # ECP block sequence number + waitsyn: int; # awaiting restart SYN SYN ... sequence + errforce: int; + addparity: int; # must add parity to outgoing data + + init: fn(m: self ref Modem, connect: int, initstr, dialstr: string); + reset: fn(m: self ref Modem); + run: fn(m: self ref Modem); + quit: fn(m: self ref Modem); + runstate: fn(m: self ref Modem, data: array of byte); + write: fn(m: self ref Modem, data: array of byte):int; # to network + reader: fn(m: self ref Modem, pidc: chan of int); +}; + +partab: array of byte; + +dump(a: array of byte, n: int): string +{ + s := sys->sprint("[%d]", n); + for(i := 0; i < n; i++) + s += sys->sprint(" %.2x", int a[i]); + return s; +} + +Modem.init(m: self ref Modem, connect: int, initstr, dialstr: string) +{ + partab = array[128] of byte; + for(c := 0; c < 128; c++) + if(parity(c)) + partab[c] = byte (c | 16r80); + else + partab[c] = byte c; + m.in = chan of ref Event; + m.connect = connect; + m.state = MSstart; + m.initstr = initstr; + m.dialstr = dialstr; + m.pid = 0; + m.spec = 0; + m.seq = 0; + m.waitsyn = 0; + m.errforce = 0; + m.addparity = 0; + m.avail = array[0] of byte; + m.rd = chan of array of byte; + m.reset(); +} + +Modem.reset(m: self ref Modem) +{ + m.m = ref Module(Pscreen, 0); +} + +Modem.run(m: self ref Modem) +{ + if(m.dialstr != nil) + send(ref Event.Eproto(Pmodem, Mmodem, Cconnect, "", 0,0,0)); +Runloop: + for(;;){ + alt { + ev := <- m.in => + pick e := ev { + Equit => + break Runloop; + Edata => + if(debug['m'] > 0) + fprint(stderr, "Modem <- %s\n", e.str()); + m.write(e.data); + if(T.state == Local || T.spec & Echo) { # loopback + if(e.from == Mkeyb) { + send(ref Event.Eproto(Pscreen, Mkeyb, Ccursor, "", 0,0,0)); + send(ref Event.Edata(Pscreen, Mkeyb, e.data)); + } + } + Eproto => + case e.cmd { + Creset => + m.reset(); + Cconnect => + if(m.pid != 0) + break; + m.addparity = 1; + T.state = Connecting; + send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); + + case m.connect { + Direct => + S.msg("Appel "+m.dialstr+" ..."); + dev := "/dev/modem"; + if(openmodem(m, dev) < 0) { + S.msg("Modem non prêt"); + T.state = Local; + send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); + break; + } + m.state = MSdialing; + m.saved = ""; + dialout(m); + T.terminalid = TERMINALID2; + Network => + S.msg("Connexion au serveur ..."); + if(debug['m'] > 0 || debug['M'] > 0) + sys->print("dial(%s)\n", m.dialstr); + (ok, cx) := sys->dial(m.dialstr, ""); + if (ok == -1){ + S.msg("Echec de la connexion"); + T.state = Local; + send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); + if(debug['m'] > 0) + sys->print("can't dial %s: %r\n", m.dialstr); + break; + } + m.fd = sys->open(cx.dir + "/data", Sys->ORDWR); + m.cfd = cx.cfd; + if(len m.dialstr >= 3 && m.dialstr[0:3] == "tcp") + m.addparity = 0; # Internet gateway apparently doesn't require parity + if(m.fd != nil) { + S.msg(nil); + m.state = MSconnected; + T.state = Online; + send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); + } + T.terminalid = TERMINALID1; + } + if(m.fd != nil) { + pidc := chan of int; + spawn m.reader(pidc); + m.pid = <-pidc; + } + Cdisconnect => + if(m.pid != 0) { + S.msg("Déconnexion ..."); + m.state = MSdisconnecting; + } + if(m.connect == Direct) + hangup(m); + else + nethangup(m); + Cplay => # for testing + case e.s { + "play" => + replay(m); + } + Crequestecp => + if(m.spec & Ecp){ # for testing: if already active, force an error + m.errforce = 1; + break; + } + m.write(array[] of {byte SEP, byte 16r4A}); +sys->print("sending request for ecp\n"); + Cstartecp => + m.spec |= Ecp; + m.seq = 0; # not in spec + m.waitsyn = 0; # not in spec + Cstopecp => + m.spec &= ~Ecp; + * => break; + } + } + b := <- m.rd => + if(debug['m'] > 0){ + fprint(stderr, "Modem -> %s\n", dump(b,len b)); + } + if(b == nil) { + m.pid = 0; + case m.state { + MSdialing => + S.msg("Echec appel"); + MSdisconnecting => + S.msg(nil); + } + m.state = MSstart; + T.state = Local; + send(ref Event.Eproto(Pscreen, Mmodem, Cscreenon, "",0,0,0)); + send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); + break; + } + m.runstate(b); + } + } + if(m.pid != 0) + kill(m.pid); + send(nil); +} + +Modem.quit(nil: self ref Modem) +{ +} + +Modem.runstate(m: self ref Modem, data: array of byte) +{ + if(debug['m']>0) + sys->print("runstate %d %s\n", m.state, dump(data, len data)); + case m.state { + MSstart => ; + MSdialing => + for(i:=0; i ; + Success => + S.msg(nil); + m.state = MSconnected; + T.state = Online; + send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); + Failure => + hangup(m); + S.msg(str); + m.state = MSstart; + T.state = Local; + send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); + } + m.saved = ""; + } + MSconnected => + send(ref Event.Edata(m.m.path, Mmodem, data)); + MSdisconnecting => ; + } +} + +Modem.write(m: self ref Modem, data: array of byte): int +{ + if(m.fd == nil) + return -1; + if(len data == 0) + return 0; + if(m.addparity){ + # unfortunately must copy data to add parity for direct modem connection + pa := array[len data] of byte; + for(i := 0; i0) + sys->print("WRITE %s\n", dump(data, len data)); + return sys->write(m.fd, data, len data); +} + +# +# minitel error correction protocol +# +# SYN, SYN, block number start of retransmission +# NUL ignored +# DLE escapes {DLE, SYN, NACK, NUL} +# NACK, block restart request +# + +crctab: array of int; +Crcpoly: con 16r9; # crc7 = x^7+x^3+1 + +# precalculate the CRC7 remainder for all bytes + +mktabs() +{ + crctab = array[256] of int; + for(c := 0; c < 256; c++){ + v := c; + crc := 0; + for(i := 0; i < 8; i++){ + crc <<= 1; # align remainder's MSB with value's + if((v^crc) & 16r80) + crc ^= Crcpoly; + v <<= 1; + } + crctab[c] = (crc<<1) & 16rFE; # pre-align the result to save <<1 later + } +} + +# return the index of the first non-NUL character (the start of a block) + +nextblock(a: array of byte, i: int, n: int): int +{ + for(; i < n; i++) + if(a[i] != byte NUL) + break; + return i; +} + +# return the data in the ecp block in a[0:Ecplen] (return nil for bad format) + +decode(a: array of byte): array of byte +{ + if(debug['M']>0) + sys->print("DECODE: %s\n", dump(a, Ecplen)); + badpar := 0; + oldcrc := int a[Ecplen-2]; + crc := 0; + op := 0; + dle := 0; + for(i:=0; i 0) + sys->print("bad parity\n"); + return nil; + } + crc = (crc>>1)&16r7F; + if(int partab[crc] != oldcrc){ + if(debug['E'] > 0) + sys->print("bad crc: in %ux got %ux\n", oldcrc, int partab[crc]); + return nil; + } + b := array[op] of byte; + b[0:] = a[0:op]; + if(debug['M'] > 0) + sys->print("OUT: %s [%x :: %x]\n", dump(b,op), crc, oldcrc); + return b; +} + +Modem.reader(m: self ref Modem, pidc: chan of int) +{ + pidc <-= sys->pctl(0, nil); + if(crctab == nil) + mktabs(); + a := array[Sys->ATOMICIO] of byte; + inbuf := 0; + while(m.fd != nil) { + while((n := read(m.fd, a[inbuf:], len a-inbuf)) > 0){ + n += inbuf; + inbuf = 0; + if((m.spec & Ecp) == 0){ + b := array[n] of byte; + for(i := 0; iprint("IN: %s\n", dump(a,n)); + i := 0; + if(m.waitsyn){ + sys->print("seeking SYN #%x\n", m.seq); + syn := byte (SYN | 16r80); + lim := n-3; + for(; i <= lim; i++) + if(a[i] == syn && a[i+1] == syn && (int a[i+2]&16r0F) == m.seq){ + i += 3; + m.waitsyn = 0; + sys->print("found SYN #%x@%d\n", m.seq, i-3); + break; + } + } + lim := n-Ecplen; + for(; (i = nextblock(a, i, n)) <= lim; i += Ecplen){ + b := decode(a[i:]); + if(m.errforce || b == nil){ + m.errforce = 0; + b = array[2] of byte; + b[0] = byte NACK; + b[1] = byte (m.seq | 16r40); + sys->print("NACK #%x\n", m.seq); + m.write(b); + m.waitsyn = 1; + i = n; # discard rest of block + break; + } + m.seq = (m.seq+1) & 16rF; # mod 16 counter + m.rd <-= b; + } + if(i < n){ + a[0:] = a[i:n]; + inbuf = n-i; + } + } + } + if(n <= 0) + break; + } +# m.fd = nil; + m.rd <-= nil; +} + +playfd: ref Sys->FD; +in_code, in_char: con iota; + +replay(m: ref Modem) +{ + buf := array[8192] of byte; + DMAX: con 10; + d := 0; + da := array[DMAX] of byte; + playfd = nil; + if(playfd == nil) + playfd = sys->open("minitel.txt", Sys->OREAD); + if(playfd == nil) + return; + nl := 1; + discard := 1; + state := in_code; + hs := ""; + start := 0; +mainloop: + for(;;) { + n := sys->read(playfd, buf, len buf); + if(n <= 0) + break; + for(i:=0; i' => discard = 0; + '<' => discard = 1; + if(start) + sys->sleep(1000); + '{' => start = 1; + '}' => break mainloop; + } + if(ch == '\n') + nl = 1; + else + nl = 0; + if(discard) + continue; + if(!start) + continue; + if(state == in_code && ((ch >= '0' && ch <= '9') || (ch >= 'a' && ch <= 'z'))) + hs[len hs] = ch; + else if(ch == '(') { + state = in_char; + (v, nil) := toint(hs, 16); + da[d++] = byte v; + if(d == DMAX) { + send(ref Event.Edata(m.m.path, Mmodem, da)); + d = 0; + da = array[DMAX] of byte; + sys->sleep(50); + } + hs = ""; + }else if(ch == ')') + state = in_code; + } + } + playfd = nil; + +} + +kill(pid : int) +{ + prog := "#p/" + string pid + "/ctl"; + fd := sys->open(prog, Sys->OWRITE); + if (fd != nil) { + cmd := array of byte "kill"; + sys->write(fd, cmd, len cmd); + } +} + + +# Modem stuff + + +# modem return codes +Ok, Success, Failure, Noise, Found: con iota; + +# +# modem return messages +# +Msg: adt { + text: string; + trans: string; + code: int; +}; + +msgs: array of Msg = array [] of { + ("OK", "Ok", Ok), + ("NO CARRIER", "No carrier", Failure), + ("ERROR", "Bad modem command", Failure), + ("NO DIALTONE", "No dial tone", Failure), + ("BUSY", "Busy tone", Failure), + ("NO ANSWER", "No answer", Failure), + ("CONNECT", "", Success), +}; + +msend(m: ref Modem, x: string): int +{ + a := array of byte x; + return sys->write(m.fd, a, len a); +} + +# +# apply a string of commands to modem +# +apply(m: ref Modem, s: string): int +{ + buf := ""; + for(i := 0; i < len s; i++){ + c := s[i]; + buf[len buf] = c; # assume no Unicode + if(c == '\r' || i == (len s -1)){ + if(c != '\r') + buf[len buf] = '\r'; + if(msend(m, buf) < 0) + return Failure; + buf = ""; + } + } + return Ok; +} + +openmodem(m: ref Modem, dev: string): int +{ + m.fd = sys->open(dev, Sys->ORDWR); + m.cfd = sys->open(dev+"ctl", Sys->ORDWR); + if(m.fd == nil || m.cfd == nil) + return -1; +# hangup(m); +# m.fd = sys->open(dev, Sys->ORDWR); +# m.cfd = sys->open(dev+"ctl", Sys->ORDWR); +# if(m.fd == nil || m.cfd == nil) +# return -1; + return 0; +} + +hangup(m: ref Modem) +{ + sys->sleep(1020); + msend(m, "+++"); + sys->sleep(1020); + apply(m, "ATH0"); + m.fd = nil; +# sys->write(m.cfd, array of byte "f", 1); + sys->write(m.cfd, array of byte "h", 1); + m.cfd = nil; + # HACK: shannon softmodem "off-hook" bug fix + sys->open("/dev/modem", Sys->OWRITE); +} + +nethangup(m: ref Modem) +{ + m.fd = nil; + sys->write(m.cfd, array of byte "hangup", 6); + m.cfd = nil; +} + + +# +# check `s' for a known reply or `substr' +# +seenreply(s: string): (int, string) +{ + for(k := 0; k < len msgs; k++) + if(len s >= len msgs[k].text && s[0:len msgs[k].text] == msgs[k].text) { + return (msgs[k].code, msgs[k].trans); + } + return (Noise, s); +} + +contains(s, t: string): int +{ + if(t == nil) + return 1; + if(s == nil) + return 0; + n := len t; + for(i := 0; i+n <= len s; i++) + if(s[i:i+n] == t) + return 1; + return 0; +} + +dialout(m: ref Modem) +{ + if(m.initstr != nil) + apply(m, "AT"+m.initstr); + if(m.dialstr != nil) { + apply(m, "ATD"+m.dialstr); + m.lastdialstr = m.dialstr; + m.dialstr = nil; + } +} diff --git a/appl/examples/minitel/screen.b b/appl/examples/minitel/screen.b new file mode 100644 index 00000000..4313d48d --- /dev/null +++ b/appl/examples/minitel/screen.b @@ -0,0 +1,1610 @@ +# +# Occasional references are made to sections and tables in the +# France Telecom Minitel specification +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +include "mdisplay.m"; + +disp: MDisplay; + +Rect, Point : import Draw; + +# display character sets +videotex, semigraphic, french, american :import MDisplay; + +# display foreground colour attributes +fgBlack, fgBlue, fgRed, fgMagenta, +fgGreen, fgCyan, fgYellow, fgWhite :import MDisplay; + +# display background colour attributes +bgBlack, bgBlue, bgRed, bgMagenta, +bgGreen, bgCyan, bgYellow, bgWhite :import MDisplay; + +fgMask, bgMask : import MDisplay; + +# display formatting attributes +attrB, attrW, attrH, attrP, attrF, attrC, attrL, attrD :import MDisplay; + +# Initial attributes - white on black +ATTR0: con fgWhite|bgBlack&~(attrB|attrW|attrH|attrP|attrF|attrC|attrL|attrD); + +# special features +Cursor, Scroll, Insert + : con (1 << iota); + +# Screen states +Sstart, Sss2, Sesc, Srepeat, Saccent, Scsi0, Scsi1, Sus0, Sus1, Sskip, +Siso2022, Siso6429, Stransparent, Sdrcs, Sconceal, Swaitfor + : con iota; + +# Filter states +FSstart, FSesc, FSsep, FS6429, FS2022: con iota; + +Screen: adt { + m: ref Module; # common attributes + ctxt: ref Draw->Context; + in: chan of ref Event; # from the terminal + + image: ref Draw->Image; # Mdisplay image + dispr40, dispr80: Rect; # 40 and 80 column display region + oldtmode: int; # old terminal mode + rows: int; # number of screen rows (25 for minitel) + cols: int; # number of screen cols (40 or 80) + cset: int; # current display charset + + pos: Point; # current writing position (x:1, y:0) + attr: int; # display attribute set + spec: int; # special features + savepos: Point; # `pos' before moving to row zero + saveattr: int; # `attr' before moving to row zero + savech: int; # last character `Put' + delimit: int; # attr changed, make next space a delimiter + cursor: int; # update cursor soon + + state: int; # recogniser state + a0: int; # recogniser arg 0 + a1: int; # recogniser arg 1 + + fstate: int; # filter state + fsaved: array of byte; # filter `chars so far' + badp: int; # filter because of bad parameter + + ignoredata: int; # ignore data from + + init: fn(s: self ref Screen, ctxt: ref Draw->Context, r40, r80: Rect); + reset: fn(s: self ref Screen); + run: fn(s: self ref Screen); + quit: fn(s: self ref Screen); + setmode: fn(s: self ref Screen, tmode: int); + runstate: fn(s: self ref Screen, data: array of byte); + put: fn(s: self ref Screen, str: string); + msg: fn(s: self ref Screen, str: string); +}; + +Screen.init(s: self ref Screen, ctxt: ref Draw->Context, r40, r80: Rect) +{ + disp = load MDisplay MDisplay->PATH; + if(disp == nil) + fatal("can't load the display module: "+MDisplay->PATH); + + s.m = ref Module(0, 0); + s.ctxt = ctxt; + s.dispr40 = r40; + s.dispr80 = r80; + s.oldtmode = -1; + s.in = chan of ref Event; + disp->Init(s.ctxt); + s.reset(); + s.pos = Point(1, 1); + s.savech = 0; + s.cursor = 1; + s.ignoredata = 0; + s.fstate = FSstart; +} + +Screen.reset(s: self ref Screen) +{ + s.setmode(T.mode); + indicators(s); + s.state = Sstart; +} + +Screen.run(s: self ref Screen) +{ +Runloop: + for(;;) alt { + ev := <- s.in => + pick e := ev { + Equit => + break Runloop; + Eproto => + case e.cmd { + Creset => + s.reset(); + Cproto => + case e.a0 { + START => + case e.a1 { + SCROLLING => + s.spec |= Scroll; + } + STOP => + case e.a1 { + SCROLLING => + s.spec &= ~Scroll; + } + MIXED => + case e.a1 { + MIXED1 => # videotex -> mixed + if(T.mode != Mixed) + s.setmode(Mixed); + T.mode = Mixed; + MIXED2 => # mixed -> videotex + if(T.mode != Videotex) + s.setmode(Videotex); + T.mode = Videotex; + } + } + Ccursor => # update the cursor soon + s.cursor = 1; + Cindicators => + indicators(s); + Cscreenoff => + s.ignoredata = 1; + s.state = Sstart; + Cscreenon => + s.ignoredata = 0; + * => break; + } + Edata => + if(s.ignoredata) + continue; + oldpos := s.pos; + oldspec := s.spec; + da := filter(s, e.data); + while(len da > 0) { + s.runstate(da[0]); + da = da[1:]; + } + + if(s.pos.x != oldpos.x || s.pos.y != oldpos.y || (s.spec&Cursor)^(oldspec&Cursor)) + s.cursor = 1; + if(s.cursor) { + if(s.spec & Cursor) + disp->Cursor(s.pos); + else + disp->Cursor(Point(-1,-1)); + s.cursor = 0; + refresh(); + } else if(e.from == Mkeyb) + refresh(); + } + } + send(nil); +} + +# row0 indicators (1.2.2) +indicators(s: ref Screen) +{ + col: int; + ch: string; + + attr := fgWhite|bgBlack; + case T.state { + Local => + ch = "F"; + Connecting => + ch = "C"; + attr |= attrF; + Online => + ch = "C"; + } + if(s.cols == 40) { + col = 39; + attr |= attrP; + } else + col = 77; + disp->Put(ch, Point(col, 0), videotex, attr, 0); +} + +Screen.setmode(s: self ref Screen, tmode: int) +{ + dispr: Rect; + delims: int; + ulheight: int; + s.rows = 25; + s.spec = 0; + s.attr = s.saveattr = ATTR0; + s.delimit = 0; + s.pos = s.savepos = Point(-1, -1); + s.cursor = 1; + case tmode { + Videotex => + s.cset = videotex; + s.cols = 40; + dispr = s.dispr40; + delims = 1; + ulheight = 2; + s.pos = Point(1,1); + s.spec &= ~Cursor; + Mixed => +# s.cset = french; + s.cset = videotex; + s.cols = 80; + dispr = s.dispr80; + delims = 0; + ulheight = 1; + s.spec |= Scroll; + s.pos = Point(1, 1); + Ascii => + s.cset = french; + s.cols = 80; + dispr = s.dispr80; + delims = 0; + ulheight = 1; + }; + if(tmode != s.oldtmode) { + (nil, s.image) = disp->Mode(((0,0),(0,0)), 0, 0, 0, 0, nil); + T.layout(s.cols); + fontpath := sprint("/fonts/minitel/f%dx%d", s.cols, s.rows); + (nil, s.image) = disp->Mode(dispr, s.cols, s.rows, ulheight, delims, fontpath); + T.setkbmode(tmode); + } + disp->Reveal(0); # concealing enabled (1.2.2) + disp->Cursor(Point(-1,-1)); + s.oldtmode = tmode; +} + +Screen.quit(nil: self ref Screen) +{ + disp->Quit(); +} + +Screen.runstate(s: self ref Screen, data: array of byte) +{ + while(len data > 0) + case T.mode { + Videotex => + data = vstate(s, data); + Mixed => + data = mstate(s, data); + Ascii => + data = astate(s, data); + }; +} + +# process a byte from set C0 +vc0(s: ref Screen, ch: int) +{ + case ch { +# SOH => # not in spec, wait for 16r04 +# s.a0 = 16r04; +# s.state = Swaitfor; + SS2 => + s.state = Sss2; + SYN => + s.state = Sss2; # not in the spec, but acts like SS2 + ESC => + s.state = Sesc; + SO => + s.cset = semigraphic; + s.attr &= ~(attrH|attrW|attrP); # 1.2.4.2 + s.attr &= ~attrL; # 1.2.4.3 + SI => + s.cset = videotex; + s.attr &= ~attrL; # 1.2.4.3 + s.attr &= ~(attrH|attrW|attrP); # some servers seem to assume this too + SEP or SS3 => # 1.2.7 + s.state = Sskip; + BS => + if(s.pos.x == 1) { + if(s.pos.y == 0) + break; + if(s.pos.y == 1) + s.pos.y = s.rows - 1; + else + s.pos.y -= 1; + s.pos.x = s.cols; + } else + s.pos.x -= 1; + HT => + if(s.pos.x == s.cols) { + if(s.pos.y == 0) + break; + if(s.pos.y == s.rows - 1) + s.pos.y = 1; + else + s.pos.y += 1; + s.pos.x = 1; + } else + s.pos.x += 1; + LF => + if(s.pos.y == s.rows - 1) + if(s.spec&Scroll) + scroll(1, 1); + else + s.pos.y = 1; + else if(s.pos.y == 0) { # restore attributes on leaving row zero + s.pos = s.savepos; + s.attr = s.saveattr; + } else + s.pos.y += 1; + VT => + if(s.pos.y == 1) + if(s.spec&Scroll) + scroll(1, -1); + else + s.pos.y = s.rows - 1; + else if(s.pos.y == 0) + break; + else + s.pos.y -= 1; + CR => + s.pos.x = 1; + CAN => + cols := s.cols - s.pos.x + 1; + disp->Put(dup(' ', cols), Point(s.pos.x,s.pos.y), s.cset, s.attr, 0); + US => + # expect US row, col + s.state = Sus0; + FF => + s.cset = videotex; + s.attr = ATTR0; + s.pos = Point(1,1); + s.spec &= ~Cursor; + s.cursor = 1; + clear(s); + RS => + s.cset = videotex; + s.attr = ATTR0; + s.pos = Point(1,1); + s.spec &= ~Cursor; + s.cursor = 1; + CON => + s.spec |= Cursor; + s.cursor = 1; + COFF => + s.spec &= ~Cursor; + s.cursor = 1; + REP => + # repeat + s.state = Srepeat; + NUL => + # padding character - ignore, but may appear anywhere + ; + BEL => + # ah ... + ; + } +} + +# process a byte from the set c1 - introduced by the ESC character +vc1(s: ref Screen, ch: int) +{ + if(ISC0(ch)) { + s.state = Sstart; + vc0(s, ch); + return; + } + if(ch >= 16r20 && ch <= 16r2f) { + if(ch == 16r25) + s.state = Stransparent; + else if(ch == 16r23) + s.state = Sconceal; + else + s.state = Siso2022; + s.a0 = s.a1 = 0; + return; + } + + fg := bg := -1; + case ch { + 16r35 or + 16r36 or + 16r37 => + s.state = Sskip; # skip next char unless C0 + return; + + 16r5b => # CSI sequence + s.a0 = s.a1 = 0; + if(s.pos.y > 0) # 1.2.5.2 + s.state = Scsi0; + return; + + # foreground colour + 16r40 => fg = fgBlack; + 16r41 => fg = fgRed; + 16r42 => fg = fgGreen; + 16r43 => fg = fgYellow; + 16r44 => fg = fgBlue; + 16r45 => fg = fgMagenta; + 16r46 => fg = fgCyan; + 16r47 => fg = fgWhite; + + # background colour + 16r50 => bg = bgBlack; + 16r51 => bg = bgRed; + 16r52 => bg = bgGreen; + 16r53 => bg = bgYellow; + 16r54 => bg = bgBlue; + 16r55 => bg = bgMagenta; + 16r56 => bg = bgCyan; + 16r57 => bg = bgWhite; + + # flashing + 16r48 => s.attr |= attrF; + 16r49 => s.attr &= ~attrF; + + # conceal (serial attribute) + 16r58 => s.attr |= attrC; + s.delimit = 1; + 16r5f => s.attr &= ~attrC; + s.delimit = 1; + + # start lining (+separated graphics) (serial attribute) + 16r5a => s.attr |= attrL; + s.delimit = 1; + 16r59 => s.attr &= ~attrL; + s.delimit = 1; + + # reverse polarity + 16r5d => s.attr |= attrP; + 16r5c => s.attr &= ~attrP; + + # normal size + 16r4c => + s.attr &= ~(attrW|attrH); + + # double height + 16r4d => + if(s.pos.y < 2) + break; + s.attr &= ~(attrW|attrH); + s.attr |= attrH; + + # double width + 16r4e => + if(s.pos.y < 1) + break; + s.attr &= ~(attrW|attrH); + s.attr |= attrW; + + # double size + 16r4f => + if(s.pos.y < 2) + break; + s.attr |= (attrW|attrH); + } + if(fg >= 0) { + s.attr &= ~fgMask; + s.attr |= fg; + } + if(bg >= 0) { + s.attr &= ~bgMask; + s.attr |= bg; + s.delimit = 1; + } + s.state = Sstart; +} + + +# process a SS2 character +vss2(s: ref Screen, ch: int) +{ + if(ISC0(ch)) { + s.state = Sstart; + vc0(s, ch); + return; + } + case ch { + 16r41 or # grave # 5.1.2 + 16r42 or # acute + 16r43 or # circumflex + 16r48 or # umlaut + 16r4b => # cedilla + s.a0 = ch; + s.state = Saccent; + return; + 16r23 => ch = '£'; # Figure 2.8 + 16r24 => ch = '$'; + 16r26 => ch = '#'; + 16r27 => ch = '§'; + 16r2c => ch = 16rc3; # '←'; + 16r2d => ch = 16rc0; # '↑'; + 16r2e => ch = 16rc4; # '→'; + 16r2f => ch = 16rc5; # '↓'; + 16r30 => ch = '°'; + 16r31 => ch = '±'; + 16r38 => ch = '÷'; + 16r3c => ch = '¼'; + 16r3d => ch = '½'; + 16r3e => ch = '¾'; + 16r7a => ch = 'œ'; + 16r6a => ch = 'Œ'; + 16r7b => ch = 'ß'; + } + s.put(tostr(ch)); + s.savech = ch; + s.state = Sstart; +} + +# process CSI functions +vcsi(s: ref Screen, ch: int) +{ + case s.state { + Scsi0 => + case ch { + # move cursor up n rows, stop at top of screen + 'A' => + s.pos.y -= s.a0; + if(s.pos.y < 1) + s.pos.y = 1; + + # move cursor down n rows, stop at bottom of screen + 'B' => + s.pos.y += s.a0; + if(s.pos.y >= s.rows) + s.pos.y = s.rows - 1; + + # move cursor n columns right, stop at edge of screen + 'C' => + s.pos.x += s.a0; + if(s.pos.x > s.cols) + s.pos.x = s.cols; + + # move cursor n columns left, stop at edge of screen + 'D' => + s.pos.x -= s.a0; + if(s.pos.x < 1) + s.pos.x = 1; + + # direct cursor addressing + ';' => + s.state = Scsi1; + return; + + 'J' => + case s.a0 { + # clears from the cursor to the end of the screen inclusive + 0 => + rowclear(s.pos.y, s.pos.x, s.cols); + for(r:=s.pos.y+1; r + for(r:=1; r + clear(s); + } + + 'K' => + case s.a0 { + # clears from the cursor to the end of the row + 0 => rowclear(s.pos.y, s.pos.x, s.cols); + + # clears from the start of the row to the cursor + 1 => rowclear(s.pos.y, 1, s.pos.x); + + # clears the entire row in which the cursor is positioned + 2 => rowclear(s.pos.y, 1, s.cols); + } + + # deletes n characters from cursor position + 'P' => + rowclear(s.pos.y, s.pos.x, s.pos.x+s.a0-1); + + # inserts n characters from cursor position + '@' => + disp->Put(dup(' ', s.a0), Point(s.pos.x,s.pos.y), s.cset, s.attr, 1); + + # starts cursor insert mode + 'h' => + if(s.a0 == 4) + s.spec |= Insert; + + 'l' => # ends cursor insert mode + if(s.a0 == 4) + s.spec &= ~Insert; + + # deletes n rows from cursor row + 'M' => + scroll(s.pos.y, s.a0); + + # inserts n rows from cursor row + 'L' => + scroll(s.pos.y, -1*s.a0); + } + s.state = Sstart; + Scsi1 => + case ch { + # direct cursor addressing + 'H' => + if(s.a0 > 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) + s.pos = Point(s.a1, s.a0); + } + s.state = Sstart; + } +} + +# Screen state - Videotex mode +vstate(s: ref Screen, data: array of byte): array of byte +{ + i: int; + for(i = 0; i < len data; i++) { + ch := int data[i]; + + if(debug['s']) { + cs:=""; + if(s.cset==videotex) cs = "v"; else cs="s"; + fprint(stderr, "vstate %d, %ux (%c) %.4ux %.4ux %s (%d,%d)\n", s.state, ch, ch, s.attr, s.spec, cs, s.pos.y, s.pos.x); + } + case s.state { + Sstart => + if(ISG0(ch) || ch == SP) { + n := 0; + str := ""; + while(i < len data) { + ch = int data[i]; + if(ISG0(ch) || ch == SP) + str[n++] = int data[i++]; + else { + i--; + break; + } + } + if(n > 0) { + if(debug['s']) + fprint(stderr, "vstate puts(%s)\n", str); + s.put(str); + s.savech = str[n-1]; + } + } else if(ISC0(ch)) + vc0(s, ch); + else if(ch == DEL) { + if(s.cset == semigraphic) + ch = 16r5f; + s.put(tostr(ch)); + s.savech = ch; + } + Sss2 => + if(ch == NUL) # 1.2.6.1 + continue; + if(s.cset == semigraphic) # 1.2.3.4 + continue; + vss2(s, ch); + Sesc => + if(ch == NUL) + continue; + vc1(s, ch); + Srepeat => + # byte from `columns' 4 to 7 gives repeat count on 6 bits + # of the last `Put' character + if(ch == NUL) + continue; + if(ISC0(ch)) { + s.state = Sstart; + vc0(s, ch); + break; + } + if(ch >= 16r40 && ch <= 16r7f) + s.put(dup(s.savech, (ch-16r40))); + s.state = Sstart; + Saccent => + case s.a0 { + 16r41 => # grave + case ch { + 'a' => ch = 'à'; + 'e' => ch = 'è'; + 'u' => ch = 'ù'; + } + 16r42 => # acute + case ch { + 'e' => ch = 'é'; + } + 16r43 => # circumflex + case ch { + 'a' => ch = 'â'; + 'e' => ch = 'ê'; + 'i' => ch = 'î'; + 'o' => ch = 'ô'; + 'u' => ch = 'û'; + } + 16r48 => # umlaut + case ch { + 'a' => ch = 'ä'; + 'e' => ch = 'ë'; + 'i' => ch = 'ï'; + 'o' => ch = 'ö'; + 'u' => ch = 'ü'; + } + 16r4b => # cedilla + case ch { + 'c' => ch = 'ç'; + } + } + s.put(tostr(ch)); + s.savech = ch; + s.state = Sstart; + Scsi0 => + if(ch >= 16r30 && ch <= 16r39) { + s.a0 *= 10; + s.a0 += (ch - 16r30); + } else if((ch >= 16r20 && ch <= 16r29) || (ch >= 16r3a && ch <= 16r3f)) { # 1.2.7 + s.a0 = 0; + s.state = Siso6429; + } else + vcsi(s, ch); + Scsi1 => + if(ch >= 16r30 && ch <= 16r39) { + s.a1 *= 10; + s.a1 += (ch - 16r30); + } else + vcsi(s, ch); + Sus0 => + if(ch == 16r23) { # start DRCS definition + s.state = Sdrcs; + s.a0 = 0; + break; + } + if(ch >= 16r40 && ch < 16r80) + s.a0 = (ch - 16r40); + else if(ch >= 16r30 && ch <= 16r32) + s.a0 = (ch - 16r30); + else + s.a0 = -1; + s.state = Sus1; + Sus1 => + if(ch >= 16r40 && ch < 16r80) + s.a1 = (ch - 16r40); + else if(ch >= 16r30 && ch <= 16r39) { + s.a1 = (ch - 16r30); + s.a0 = s.a0*10 + s.a1; # shouldn't be used any more + s.a1 = 1; + } else + s.a1 = -1; + # US row, col : this is how you get to row zero + if(s.a0 >= 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) { + if(s.a0 == 0 && s.pos.y > 0) { + s.savepos = s.pos; + s.saveattr = s.attr; + } + s.pos = Point(s.a1, s.a0); + s.delimit = 0; # 1.2.5.3, don't reset serial attributes + s.attr = ATTR0; + s.cset = videotex; + } + s.state = Sstart; + Sskip => + # swallow the next character unless from C0 + s.state = Sstart; + if(ISC0(ch)) + vc0(s, ch); + Swaitfor => + # ignore characters until the character in a0 inclusive + if(ch == s.a0) + s.state = Sstart; + Siso2022 => + # 1.2.7 + # swallow (upto) 3 characters from column 2, + # then 1 character from columns 3 to 7 + if(ch == NUL) + continue; + if(ISC0(ch)) { + s.state = Sstart; + vc0(s, ch); + break; + } + s.a0++; + if(s.a0 <= 3) { + if(ch >= 16r20 && ch <= 16r2f) + break; + } + if (s.a0 <= 4 && ch >= 16r30 && ch <= 16r7f) { + s.state = Sstart; + break; + } + s.state = Sstart; + s.put(tostr(DEL)); + Siso6429 => + # 1.2.7 + # swallow characters from column 3, + # or column 2, then 1 from column 4 to 7 + if(ISC0(ch)) { + s.state = Sstart; + vc0(s, ch); + break; + } + if(ch >= 16r20 && ch <= 16r3f) + break; + if(ch >= 16r40 && ch <= 16r7f) { + s.state = Sstart; + break; + } + s.state = Sstart; + s.put(tostr(DEL)); + Stransparent => + # 1.2.7 + # ignore all codes until ESC, 25, 40 or ESC, 2F, 3F + # progress in s.a0 and s.a1 + match := array [] of { + array [] of { ESC, 16r25, 16r40 }, + array [] of { ESC, 16r2f, 16r3f }, + }; + if(ch == ESC) { + s.a0 = s.a1 = 1; + break; + } + if(ch == match[0][s.a0]) + s.a0++; + else + s.a0 = 0; + if(ch == match[1][s.a1]) + s.a1++; + else + s.a1 = 0; + if(s.a0 == 3 || s.a1 == 3) + s.state = Sstart; + Sdrcs => + if(s.a0 > 0) { # fixed number of bytes to skip in a0 + s.a0--; + if(s.a0 == 0) { + s.state = Sstart; + break; + } + } else if(ch == US) # US XX YY - end of DRCS + s.state = Sus0; + else if(ch == 16r20) # US 23 20 20 20 4[23] 49 + s.a0 = 4; + Sconceal => + # 1.2.4.4 + # ESC 23 20 58 - Conceal fields + # ESC 23 20 5F - Reveal fields + # ESC 23 21 XX - Filter + # progress in s.a0 + case s.a0 { + 0 => + if(ch == 16r20 || ch == 16r21) + s.a0 = ch; + 16r20 => + case ch { + 16r58 => + disp->Reveal(0); + disp->Refresh(); + 16r5f => + disp->Reveal(1); + disp->Refresh(); + } + s.state = Sstart; + 16r21 => + s.state = Sstart; + } + } + } + if (i < len data) + return data[i:]; + else + return nil; +} + +# Screen state - Mixed mode +mstate(s: ref Screen, data: array of byte): array of byte +{ + i: int; +Stateloop: + for(i = 0; i < len data; i++) { + ch := int data[i]; + + if(debug['s']) { + cs:=""; + if(s.cset==videotex) cs = "v"; else cs="s"; + fprint(stderr, "mstate %d, %ux (%c) %.4ux %.4ux %s (%d,%d)\n", s.state, ch, ch, s.attr, s.fstate, cs, s.pos.y, s.pos.x); + } + case s.state { + Sstart => + if(ISG0(ch) || ch == SP) { + n := 0; + str := ""; + while(i < len data) { + ch = int data[i]; + if(ISG0(ch) || ch == SP) + str[n++] = int data[i++]; + else { + i--; + break; + } + } + if(n > 0) { + if(debug['s']) + fprint(stderr, "mstate puts(%s)\n", str); + s.put(str); + s.savech = str[n-1]; + } + } else if(ISC0(ch)) + mc0(s, ch); + else if(ch == DEL) { + if(s.cset == semigraphic) + ch = 16r5f; + s.put(tostr(ch)); + s.savech = ch; + } + Sesc => + if(ch == NUL) + continue; + mc1(s, ch); + Scsi0 => + if(ch >= 16r30 && ch <= 16r39) { + s.a0 *= 10; + s.a0 += (ch - 16r30); + } else if(ch == '?') { + s.a0 = '?'; + } else + mcsi(s, ch); + if(T.mode != Mixed) # CSI ? { changes to Videotex mode + break Stateloop; + Scsi1 => + if(ch >= 16r30 && ch <= 16r39) { + s.a1 *= 10; + s.a1 += (ch - 16r30); + } else + mcsi(s, ch); + Sus0 => + if(ch >= 16r40 && ch < 16r80) + s.a0 = (ch - 16r40); + else if(ch >= 16r30 && ch <= 16r32) + s.a0 = (ch - 16r30); + else + s.a0 = -1; + s.state = Sus1; + Sus1 => + if(ch >= 16r40 && ch < 16r80) + s.a1 = (ch - 16r40); + else if(ch >= 16r30 && ch <= 16r39) { + s.a1 = (ch - 16r30); + s.a0 = s.a0*10 + s.a1; # shouldn't be used any more + s.a1 = 1; + } else + s.a1 = -1; + # US row, col : this is how you get to row zero + if(s.a0 >= 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) { + if(s.a0 == 0 && s.pos.y > 0) { + s.savepos = s.pos; + s.saveattr = s.attr; + } + s.pos = Point(s.a1, s.a0); + s.delimit = 0; # 1.2.5.3, don't reset serial attributes + s.attr = ATTR0; + s.cset = videotex; + } + s.state = Sstart; + Siso6429 => + # 1.2.7 + # swallow characters from column 3, + # or column 2, then 1 from column 4 to 7 + if(ISC0(ch)) { + s.state = Sstart; + mc0(s, ch); + break; + } + if(ch >= 16r20 && ch <= 16r3f) + break; + if(ch >= 16r40 && ch <= 16r7f) { + s.state = Sstart; + break; + } + s.state = Sstart; + s.put(tostr(DEL)); + } + } + if (i < len data) + return data[i:]; + else + return nil; + return nil; +} + +# process a byte from set C0 - Mixed mode +mc0(s: ref Screen, ch: int) +{ + case ch { + ESC => + s.state = Sesc; + SO => +# s.cset = french; + ; + SI => +# s.cset = american; + ; + BS => + if(s.pos.x > 1) + s.pos.x -= 1; + HT => + s.pos.x += 8; + if(s.pos.x > s.cols) + s.pos.x = s.cols; + LF or VT or FF => + if(s.pos.y == s.rows - 1) + if(s.spec&Scroll) + scroll(1, 1); + else + s.pos.y = 1; + else if(s.pos.y == 0) { # restore attributes on leaving row zero + if(ch == LF) { # 4.5 + s.pos = s.savepos; + s.attr = s.saveattr; + } + } else + s.pos.y += 1; + CR => + s.pos.x = 1; + CAN or SUB => # displays the error symbol - filled in rectangle + disp->Put(dup(16r5f, 1), Point(s.pos.x,s.pos.y), s.cset, s.attr, 0); + NUL => + # padding character - ignore, but may appear anywhere + ; + BEL => + # ah ... + ; + XON => # screen copying + ; + XOFF => # screen copying + ; + US => + # expect US row, col + s.state = Sus0; + } +} + +# process a byte from the set c1 - introduced by the ESC character - Mixed mode +mc1(s: ref Screen, ch: int) +{ + if(ISC0(ch)) { + s.state = Sstart; + mc0(s, ch); + return; + } + case ch { + 16r5b => # CSI sequence + s.a0 = s.a1 = 0; + if(s.pos.y > 0) # 1.2.5.2 + s.state = Scsi0; + return; + + 16r44 or # IND like LF + 16r45 => # NEL like CR LF + if(ch == 16r45) + s.pos.x = 1; + if(s.pos.y == s.rows - 1) + if(s.spec&Scroll) + scroll(1, 1); + else + s.pos.y = 1; + else if(s.pos.y == 0) { # restore attributes on leaving row zero + s.pos = s.savepos; + s.attr = s.saveattr; + } else + s.pos.y += 1; + 16r4d => # RI + if(s.pos.y == 1) + if(s.spec&Scroll) + scroll(1, -1); + else + s.pos.y = s.rows - 1; + else if(s.pos.y == 0) + break; + else + s.pos.y -= 1; + } + s.state = Sstart; +} + + +# process CSI functions - Mixed mode +mcsi(s: ref Screen, ch: int) +{ + case s.state { + Scsi0 => + case ch { + # move cursor up n rows, stop at top of screen + 'A' => + if(s.a0 == 0) + s.a0 = 1; + s.pos.y -= s.a0; + if(s.pos.y < 1) + s.pos.y = 1; + + # move cursor down n rows, stop at bottom of screen + 'B' => + if(s.a0 == 0) + s.a0 = 1; + s.pos.y += s.a0; + if(s.pos.y >= s.rows) + s.pos.y = s.rows - 1; + + # move cursor n columns right, stop at edge of screen + 'C' => + if(s.a0 == 0) + s.a0 = 1; + s.pos.x += s.a0; + if(s.pos.x > s.cols) + s.pos.x = s.cols; + + # move cursor n columns left, stop at edge of screen + 'D' => + if(s.a0 == 0) + s.a0 = 1; + s.pos.x -= s.a0; + if(s.pos.x < 1) + s.pos.x = 1; + + # second parameter + ';' => + s.state = Scsi1; + return; + + 'J' => + case s.a0 { + # clears from the cursor to the end of the screen inclusive + 0 => + rowclear(s.pos.y, s.pos.x, s.cols); + for(r:=s.pos.y+1; r + for(r:=1; r + clear(s); + } + + 'K' => + case s.a0 { + # clears from the cursor to the end of the row + 0 => rowclear(s.pos.y, s.pos.x, s.cols); + + # clears from the start of the row to the cursor + 1 => rowclear(s.pos.y, 1, s.pos.x); + + # clears the entire row in which the cursor is positioned + 2 => rowclear(s.pos.y, 1, s.cols); + } + + # inserts n characters from cursor position + '@' => + disp->Put(dup(' ', s.a0), Point(s.pos.x,s.pos.y), s.cset, s.attr, 1); + + # starts cursor insert mode + 'h' => + if(s.a0 == 4) + s.spec |= Insert; + + 'l' => # ends cursor insert mode + if(s.a0 == 4) + s.spec &= ~Insert; + + # inserts n rows from cursor row + 'L' => + scroll(s.pos.y, -1*s.a0); + s.pos.x = 1; + + # deletes n rows from cursor row + 'M' => + scroll(s.pos.y, s.a0); + s.pos.x = 1; + + # deletes n characters from cursor position + 'P' => + rowclear(s.pos.y, s.pos.x, s.pos.x+s.a0-1); + + # select Videotex mode + '{' => + if(s.a0 == '?') { + T.mode = Videotex; + s.setmode(T.mode); + } + + # display attributes + 'm' => + case s.a0 { + 0 => s.attr &= ~(attrL|attrF|attrP|attrB); + 1 => s.attr |= attrB; + 4 => s.attr |= attrL; + 5 => s.attr |= attrF; + 7 => s.attr |= attrP; + 22 => s.attr &= ~attrB; + 24 => s.attr &= ~attrL; + 25 => s.attr &= ~attrF; + 27 => s.attr &= ~attrP; + } + # direct cursor addressing + 'H' => + if(s.a0 == 0) + s.a0 = 1; + if(s.a1 == 0) + s.a1 = 1; + if(s.a0 > 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) + s.pos = Point(s.a1, s.a0); + } + s.state = Sstart; + Scsi1 => + case ch { + # direct cursor addressing + 'H' => + if(s.a0 == 0) + s.a0 = 1; + if(s.a1 == 0) + s.a1 = 1; + if(s.a0 > 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) + s.pos = Point(s.a1, s.a0); + } + s.state = Sstart; + } +} + + +# Screen state - ASCII mode +astate(nil: ref Screen, nil: array of byte): array of byte +{ + return nil; +} + +# Put a string in the current attributes to the current writing position +Screen.put(s: self ref Screen, str: string) +{ + while((l := len str) > 0) { + n := s.cols - s.pos.x + 1; # characters that will fit on this row + if(s.attr & attrW) { + if(n > 1) # fit normal width character in last column + n /= 2; + } + if(n > l) + n = l; + if(s.delimit) { # set delimiter bit on 1st space (if any) + for(i:=0; i 0) { + disp->Put(str[0:i], s.pos, s.cset, s.attr, s.spec&Insert); + incpos(s, i); + } + if(i < n) { + if(debug['s']) { + cs:=""; + if(s.cset==videotex) cs = "v"; else cs="s"; + fprint(stderr, "D %ux %s\n", s.attr|attrD, cs); + } + disp->Put(tostr(str[i]), s.pos, s.cset, s.attr|attrD, s.spec&Insert); + incpos(s, 1); + s.delimit = 0; + # clear serial attributes once used + # hang onto background attribute - needed for semigraphics + case s.cset { + videotex => + s.attr &= ~(attrL|attrC); + semigraphic => + s.attr &= ~(attrC); + } + } + if(i < n-1) { + disp->Put(str[i+1:n], s.pos, s.cset, s.attr, s.spec&Insert); + incpos(s, n-(i+1)); + } + } else { + disp->Put(str[0:n], s.pos, s.cset, s.attr, s.spec&Insert); + incpos(s, n); + } + if(n < len str) + str = str[n:]; + else + str = nil; + } +# if(T.state == Local || T.spec&Echo) +# refresh(); +} + +# increment the current writing position by `n' cells. +# caller must ensure that `n' characters can fit +incpos(s: ref Screen, n: int) +{ + if(s.attr & attrW) + s.pos.x += 2*n; + else + s.pos.x += n; + if(s.pos.x > s.cols) + if(s.pos.y == 0) # no wraparound from row zero + s.pos.x = s.cols; + else { + s.pos.x = 1; + if(s.pos.y == s.rows - 1 && s.spec&Scroll) { + if(s.attr & attrH) { + scroll(1, 2); + } else { + scroll(1, 1); + rowclear(s.pos.y, 1, s.cols); + } + } else { + if(s.attr & attrH) + s.pos.y += 2; + else + s.pos.y += 1; + if(s.pos.y >= s.rows) + s.pos.y -= (s.rows-1); + } + } +} + +# clear row `r' from `first' to `last' column inclusive +rowclear(r, first, last: int) +{ + # 16r5f is the semi-graphic black rectangle + disp->Put(dup(16r5f, last-first+1), Point(first,r), semigraphic, fgBlack, 0); +# disp->Put(dup(' ', last-first+1), Point(first,r), S.cset, fgBlack, 0); +} + +clear(s: ref Screen) +{ + for(r:=1; rRefresh(); +} + +# scroll the screen +scroll(topline, nlines: int) +{ + disp->Scroll(topline, nlines); + disp->Refresh(); +} + +# filter the specified ISO6429 and ISO2022 codes from the screen input +# TODO: filter some ISO2022 sequences +filter(s: ref Screen, data: array of byte): array of array of byte +{ + case T.mode { + Videotex => + return vfilter(s, data); + Mixed => + return mfilter(s, data); + Ascii => + return afilter(s, data); + } + return nil; +} + +# filter the specified ISO6429 and ISO2022 codes from the screen input +vfilter(s: ref Screen, data: array of byte): array of array of byte +{ + ba := array [0] of array of byte; + changed := 0; + + d0 := 0; + for(i:=0; i + if(ch == ESC) { + s.fstate = FSesc; + changed = 1; + if(i > d0) + ba = dappend(ba, data[d0:i]); + d0 = i+1; + } + FSesc => + d0 = i+1; + changed = 1; + if(ch == '[') { + s.fstate = FS6429; + s.fsaved = array [0] of byte; + s.badp = 0; +# } else if(ch == 16r20) { +# s.fstate = FS2022; +# s.fsaved = array [0] of byte; + s.badp = 0; + } else if(ch == ESC) { + ba = dappend(ba, array [] of { byte ESC }); + s.fstate = FSesc; + } else { + # false alarm - don't filter + ba = dappend(ba, array [] of { byte ESC, byte ch }); + s.fstate = FSstart; + } + FS6429 => # filter out invalid CSI sequences + d0 = i+1; + changed = 1; + if(ch >= 16r20 && ch <= 16r3f) { + if((ch < 16r30 || ch > 16r39) && ch != ';') + s.badp = 1; + a := array [len s.fsaved + 1] of byte; + a[0:] = s.fsaved[0:]; + a[len a - 1] = byte ch; + s.fsaved = a; + } else { + valid := 1; + case ch { + 'A' => ; + 'B' => ; + 'C' => ; + 'D' => ; + 'H' => ; + 'J' => ; + 'K' => ; + 'P' => ; + '@' => ; + 'h' => ; + 'l' => ; + 'M' => ; + 'L' => ; + * => + valid = 0; + } + if(s.badp) + valid = 0; + if(debug['f']) + fprint(stderr, "vfilter %d: %s%c\n", valid, string s.fsaved, ch); + if(valid) { # false alarm - don't filter + ba = dappend(ba, array [] of { byte ESC, byte '[' }); + ba = dappend(ba, s.fsaved); + ba = dappend(ba, array [] of { byte ch } ); + } + s.fstate = FSstart; + } + FS2022 => ; + } + } + if(changed) { + if(i > d0) + ba = dappend(ba, data[d0:i]); + return ba; + } + return array [] of { data }; +} + +# filter the specified ISO6429 and ISO2022 codes from the screen input - Videotex +mfilter(s: ref Screen, data: array of byte): array of array of byte +{ + ba := array [0] of array of byte; + changed := 0; + + d0 := 0; + for(i:=0; i + case ch { + ESC => + s.fstate = FSesc; + changed = 1; + if(i > d0) + ba = dappend(ba, data[d0:i]); + d0 = i+1; + SEP => + s.fstate = FSsep; + changed = 1; + if(i > d0) + ba = dappend(ba, data[d0:i]); + d0 = i+1; + } + FSesc => + d0 = i+1; + changed = 1; + if(ch == '[') { + s.fstate = FS6429; + s.fsaved = array [0] of byte; + s.badp = 0; + } else if(ch == ESC) { + ba = dappend(ba, array [] of { byte ESC }); + s.fstate = FSesc; + } else { + # false alarm - don't filter + ba = dappend(ba, array [] of { byte ESC, byte ch }); + s.fstate = FSstart; + } + FSsep => + d0 = i+1; + changed = 1; + if(ch == ESC) { + ba = dappend(ba, array [] of { byte SEP }); + s.fstate = FSesc; + } else if(ch == SEP) { + ba = dappend(ba, array [] of { byte SEP }); + s.fstate = FSsep; + } else { + if(ch >= 16r00 && ch <= 16r1f) + ba = dappend(ba, array [] of { byte SEP , byte ch }); + # consume the character + s.fstate = FSstart; + } + FS6429 => # filter out invalid CSI sequences + d0 = i+1; + changed = 1; + if(ch >= 16r20 && ch <= 16r3f) { + if((ch < 16r30 || ch > 16r39) && ch != ';' && ch != '?') + s.badp = 1; + a := array [len s.fsaved + 1] of byte; + a[0:] = s.fsaved[0:]; + a[len a - 1] = byte ch; + s.fsaved = a; + } else { + valid := 1; + case ch { + 'm' => ; + 'A' => ; + 'B' => ; + 'C' => ; + 'D' => ; + 'H' => ; + 'J' => ; + 'K' => ; + '@' => ; + 'h' => ; + 'l' => ; + 'L' => ; + 'M' => ; + 'P' => ; + '{' => # allow CSI ? { + n := len s.fsaved; + if(n == 0 || s.fsaved[n-1] != byte '?') + s.badp = 1; + * => + valid = 0; + } + if(s.badp) # only decimal params + valid = 0; + if(debug['f']) + fprint(stderr, "mfilter %d: %s%c\n", valid, string s.fsaved, ch); + if(valid) { # false alarm - don't filter + ba = dappend(ba, array [] of { byte ESC, byte '[' }); + ba = dappend(ba, s.fsaved); + ba = dappend(ba, array [] of { byte ch } ); + } + s.fstate = FSstart; + } + FS2022 => ; + } + } + if(changed) { + if(i > d0) + ba = dappend(ba, data[d0:i]); + return ba; + } + return array [] of { data }; +} + +# filter the specified ISO6429 and ISO2022 codes from the screen input - Videotex +afilter(nil: ref Screen, data: array of byte): array of array of byte +{ + return array [] of { data }; +} + +# append to an array of array of byte +dappend(ba: array of array of byte, b: array of byte): array of array of byte +{ + l := len ba; + na := array [l+1] of array of byte; + na[0:] = ba[0:]; + na[l] = b; + return na; +} + +# Put a diagnostic string to row 0 +Screen.msg(s: self ref Screen, str: string) +{ + blank := string array [s.cols -4] of {* => byte ' '}; + n := len str; + if(n > s.cols - 4) + n = s.cols - 4; + disp->Put(blank, Point(1, 0), videotex, 0, 0); + if(str != nil) + disp->Put(str[0:n], Point(1, 0), videotex, fgWhite|attrB, 0); + disp->Refresh(); +} \ No newline at end of file diff --git a/appl/examples/minitel/socket.b b/appl/examples/minitel/socket.b new file mode 100644 index 00000000..b3ce7fcf --- /dev/null +++ b/appl/examples/minitel/socket.b @@ -0,0 +1,49 @@ +# +# Copyright © 1998 Vita Nuova Limited. All rights reserved. +# + +Socket: adt { + m: ref Module; # common attributes + in: chan of ref Event; + + init: fn(c: self ref Socket); + reset: fn(c: self ref Socket); + run: fn(c: self ref Socket); + quit: fn(c: self ref Socket); +}; + +Socket.init(c: self ref Socket) +{ + c.in = chan of ref Event; + c.reset(); +} + +Socket.reset(c: self ref Socket) +{ + c.m = ref Module(Pscreen, 0); +} + +Socket.run(c: self ref Socket) +{ +Runloop: + for(;;){ + ev := <- c.in; + pick e := ev { + Equit => + break Runloop; + Eproto => + case e.cmd { + Creset => + c.reset(); + * => break; + } + Edata => + } + } + send(nil); +} + +Socket.quit(c: self ref Socket) +{ + if(c==nil); +} diff --git a/appl/examples/minitel/swkeyb.b b/appl/examples/minitel/swkeyb.b new file mode 100644 index 00000000..50cb238f --- /dev/null +++ b/appl/examples/minitel/swkeyb.b @@ -0,0 +1,370 @@ +### +### This data and information is not to be used as the basis of manufacture, +### or be reproduced or copied, or be distributed to another party, in whole +### or in part, without the prior written consent of Lucent Technologies. +### +### (C) Copyright 1997 Lucent Technologies +### +### Written by N. W. Knauft +### +# +# Revisions Copyright © 1998 Vita Nuova Limited. + +implement Keyboard; + +include "sys.m"; + sys: Sys; + +include "draw.m"; + draw: Draw; + +include "tk.m"; + tk: Tk; + +include "tkclient.m"; + tkclient: Tkclient; + +include "swkeyb.m"; + +#Icon path +ICPATH: con "keybd/"; + +#Font +FONT: con "/fonts/lucidasans/latin1.7.font"; +SPECFONT: con "/fonts/lucidasans/latin1.6.font"; + +# Dimension constants +KBDWIDTH: con 360; +KBDHEIGHT: con 120; +KEYSIZE: con "19"; +KEYSPACE: con 5; +KEYBORDER: con 1; +KEYGAP: con KEYSPACE - (2 * KEYBORDER); +ENDGAP: con 2 - KEYBORDER; + +# Row size constants (cumulative) +ROW1: con 14; +ROW2: con 28; +ROW3: con 41; +ROW4: con 53; +NKEYS: con 63; + +#Special key number constants +DELKEY: con 13; +TABKEY: con 14; +BACKSLASHKEY: con 27; +CAPSLOCKKEY: con 28 ; +RETURNKEY: con 40; +LSHIFTKEY: con 41; +RSHIFTKEY: con 52; +ESCKEY: con 53; +CTRLKEY: con 54; +METAKEY: con 55; +ALTKEY: con 56; +SPACEKEY: con 57; +ENTERKEY: con 58; +LEFTKEY: con 59; +RIGHTKEY: con 60; +DOWNKEY: con 61; +UPKEY: con 62; + +#Special key code constants +CAPSLOCK: con -1 ; +SHIFT: con -2; +CTRL: con -3; +ALT: con -4; +META: con -5; +MAGIC_PREFIX: con 256; +ARROW_OFFSET: con 57344; +ARROW_PREFIX: con ARROW_OFFSET + 18; + +#Special key width constants +DELSIZE: con 44; +TABSIZE: con 32; +BACKSLASHSIZE: con 31; +CAPSLOCKSIZE: con 44; +RETURNSIZE: con 43; +LSHIFTSIZE: con 56; +RSHIFTSIZE: con 55; +ESCSIZE: con 21; +CTRLSIZE: con 23; +METASIZE: con 38; +ALTSIZE: con 22; +SPACESIZE: con 100; +ENTERSIZE: con 31; + +#Arrow key code constants +UP: con ARROW_PREFIX; +DOWN: con ARROW_PREFIX + 1; +LEFT: con ARROW_PREFIX + 2; +RIGHT: con ARROW_PREFIX + 3; + +direction:= array[] of {"up", "down", "left", "right"}; +row_dimensions:= array[] of {0, ROW1, ROW2, ROW3, ROW4, NKEYS}; + +special_keys:= array[] of { + (DELKEY, DELSIZE), + (TABKEY, TABSIZE), + (BACKSLASHKEY, BACKSLASHSIZE), + (CAPSLOCKKEY, CAPSLOCKSIZE), + (RETURNKEY, RETURNSIZE), + (LSHIFTKEY, LSHIFTSIZE), + (RSHIFTKEY, RSHIFTSIZE), + (ESCKEY, ESCSIZE), + (CTRLKEY, CTRLSIZE), + (METAKEY, METASIZE), + (ALTKEY, ALTSIZE), + (SPACEKEY, SPACESIZE), + (ENTERKEY, ENTERSIZE), +}; + +keys:= array[] of { + # Unshifted + "`", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "-", "=", "Delete", + "Tab", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "\\\\", + "CapLoc", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "\'", "Return", + "Shift", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "Shift", + "Esc", "Ctrl", " ", "Alt", " ", "Enter", "<-", "->", "v", "^", + # Shifted + "~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "Delete", + "Tab", "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "\\{", "\\}", "|", + "CapLoc", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", "\"", "Return", + "Shift", "Z", "X", "C", "V", "B", "N", "M", "<", ">", "?", "Shift", + "Esc", "Ctrl", " ", "Alt", " ", "Enter", "<-", "->", "v", "^", +}; + +keyvals:= array[] of { + # Unshifted + '`', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '-', '=', '\b', + '\t', 'q', 'w', 'e', 'r', 't', 'y', 'u', 'i', 'o', 'p', '[', ']', '\\', + CAPSLOCK, 'a', 's', 'd', 'f', 'g', 'h', 'j', 'k', 'l', ';', '\'', '\n', + SHIFT, 'z', 'x', 'c', 'v', 'b', 'n', 'm', ',', '.', '/', SHIFT, + 27, CTRL, META, ALT, 32, '\n', LEFT, RIGHT, DOWN, UP, + # Shifted + '~', '!', '@', '#', '$', '%', '^', '&', '*', '(', ')', '_', '+', '\b', + '\t', 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', 'O', 'P', '{', '}', '|', + CAPSLOCK, 'A', 'S', 'D', 'F', 'G', 'H', 'J', 'K', 'L', ':', '"', '\n', + SHIFT, 'Z', 'X', 'C', 'V', 'B', 'N', 'M', '<', '>', '?', SHIFT, + 27, CTRL, META, ALT, 32, '\n', LEFT, RIGHT, DOWN, UP, +}; + +rowlayout := array[] of { + "frame .f1", + "frame .f2", + "frame .f3", + "frame .f4", + "frame .f5", + "frame .dummy0 -height " + string (ENDGAP), + "frame .dummy1 -height " + string KEYGAP, + "frame .dummy2 -height " + string KEYGAP, + "frame .dummy3 -height " + string KEYGAP, + "frame .dummy4 -height " + string KEYGAP, + "frame .dummy5 -height " + string (ENDGAP + 1), +}; + +# Move key flags +move_key_enabled := 0; +meta_active := 0; + +# Create keyboard widget, spawn keystroke handler +initialize(t: ref Tk->Toplevel, ctxt : ref Draw->Context, dot: string): chan of string +{ + return chaninit(t, ctxt, dot, chan of string); +} + +chaninit(t: ref Tk->Toplevel, ctxt : ref Draw->Context, dot: string, rc: chan of string): chan of string +{ + sys = load Sys Sys->PATH; + draw = load Draw Draw->PATH; + tk = load Tk Tk->PATH; + tkclient = load Tkclient Tkclient->PATH; + + tkclient->init(); + + tk->cmd(t, "frame " + dot + " -bd 2 -relief raised -width " + string KBDWIDTH + + " -height " + string KBDHEIGHT); + tkcmds(t, rowlayout); + + for(i := 0; i < NKEYS; i++) { + tk->cmd(t, "button .b" + string i + " -font " + FONT + " -width " + KEYSIZE + + " -height " + KEYSIZE + " -bd " + string KEYBORDER); + + tk->cmd(t, ".b" + string i + " configure -text {" + keys[i] + + "} -command 'send keypress " + string keyvals[i]); + } + + for(i = 0; i < len special_keys; i++) { + (keynum, keysize) := special_keys[i]; + tk->cmd(t, ".b" + string keynum + " configure -font " + SPECFONT + " -width " + string keysize); + } + + tk->cmd(t, "image create bitmap Capslock_on -file " + ICPATH + "capson.bit -maskfile " + ICPATH + "capson.bit"); + tk->cmd(t, "image create bitmap Capslock_off -file " + ICPATH + "capsoff.bit -maskfile " + ICPATH + "capsoff.bit"); + tk->cmd(t, "image create bitmap Left_arrow -file " + ICPATH + "larrow.bit -maskfile " + ICPATH + "larrow.bit"); + tk->cmd(t, "image create bitmap Right_arrow -file " + ICPATH + "rarrow.bit -maskfile " + ICPATH + "rarrow.bit"); + tk->cmd(t, "image create bitmap Down_arrow -file " + ICPATH + "darrow.bit -maskfile " + ICPATH + "darrow.bit"); + tk->cmd(t, "image create bitmap Up_arrow -file " + ICPATH + "uarrow.bit -maskfile " + ICPATH + "uarrow.bit"); + tk->cmd(t, "image create bitmap Move_on -file " + ICPATH + "moveon.bit -maskfile " + ICPATH + "moveon.bit"); + tk->cmd(t, "image create bitmap Move_off -file " + ICPATH + "moveoff.bit -maskfile " + ICPATH + "moveoff.bit"); + tk->cmd(t, "image create bitmap None -file " + ICPATH + "none.bit -maskfile " + ICPATH + "none.bit"); + tk->cmd(t, ".b" + string CAPSLOCKKEY + " configure -image Capslock_off"); + tk->cmd(t, ".b" + string LEFTKEY + " configure -image Left_arrow"); + tk->cmd(t, ".b" + string RIGHTKEY + " configure -image Right_arrow"); + tk->cmd(t, ".b" + string DOWNKEY + " configure -image Down_arrow"); + tk->cmd(t, ".b" + string UPKEY + " configure -image Up_arrow"); + + for(j:=1; j < len row_dimensions; j++) { + rowstart := row_dimensions[j-1]; + rowend := row_dimensions[j]; + for(i=rowstart; icmd(t, "frame .f" + string j + ".dummy -width " + string ENDGAP); + tk->cmd(t, "pack .f" + string j + ".dummy -side left"); + } + tk->cmd(t, "pack .b" + string i + " -in .f" + string j + " -side left"); + if (i == rowend-1) + tk->cmd(t, "frame .f" + string j + ".dummy" + string i + " -width " + string ENDGAP); + else + tk->cmd(t, "frame .f" + string j + ".dummy" + string i + " -width " + string KEYGAP); + tk->cmd(t, "pack .f" + string j + ".dummy" + string i + " -side left"); + } + } + + tk->cmd(t, "pack .dummy0 .f1 .dummy1 .f2 .dummy2 .f3 .dummy3 .f4 .dummy4 .f5 .dummy5 -in " + dot); + tk->cmd(t,"update"); + + key := chan of string; + spawn handle_keyclicks(t, ctxt, key, rc); + return key; +} + +tkcmds(t: ref Tk->Toplevel, cmds: array of string) +{ + for(i := 0; i < len cmds; i++) + tk->cmd(t, cmds[i]); +} + +# Process key clicks and hand keycodes off to Tk +handle_keyclicks(t: ref Tk->Toplevel, ctxt : ref Draw->Context, sc, rc: chan of string) +{ + keypress := chan of string; + tk->namechan(t, keypress, "keypress"); + + minitel := 0; + caps_locked := 0; + shifted := 0; + ctrl_active := 0; + alt_active := 0; + +Work: + for(;;){ + alt { + k := <-keypress => + (n, cmdstr) := sys->tokenize(k, " \t\n"); + keycode := int hd cmdstr; + case keycode { + CAPSLOCK => + redisplay_keyboard(t, minitel, caps_locked ^= 1, caps_locked); + shifted = 0; + ctrl_active = 0; + alt_active = 0; + SHIFT => + redisplay_keyboard(t, minitel, (shifted ^= 1) ^ caps_locked, caps_locked); + CTRL => + ctrl_active ^= 1; + if (shifted) { + redisplay_keyboard(t, minitel, caps_locked, caps_locked); + shifted = 0; + } + alt_active = 0; + ALT => + alt_active ^= 1; + if (shifted) { + redisplay_keyboard(t, minitel, caps_locked, caps_locked); + shifted = 0; + } + ctrl_active = 0; + META => + if (move_key_enabled) { + if (meta_active ^= 1) + tk->cmd(t, ".b" + string METAKEY + " configure -image Move_on"); + else + tk->cmd(t, ".b" + string METAKEY + " configure -image Move_off"); + } + redisplay_keyboard(t, minitel, caps_locked, caps_locked); + shifted = 0; + ctrl_active = 0; + alt_active = 0; + * => + if (ctrl_active) { + keycode &= 16r1F; + ctrl_active = 0; + } else if (alt_active) { + keycode += MAGIC_PREFIX; + alt_active = 0; + } + if (meta_active && UP <= keycode && keycode <= RIGHT) { + spawn send_move_msg(direction[keycode - ARROW_PREFIX], sc); + } else + tk->keyboard(t, keycode); + if (shifted) { + redisplay_keyboard(t, minitel, caps_locked, caps_locked); + shifted = 0; + } + } + s := <-rc => + case s { + "kill" => + break Work; + "minitel" => + if (!minitel) { + minitel = 1; + redisplay_keyboard(t, minitel, shifted, caps_locked); + } + "standard" => + if (minitel) { + minitel = 0; + redisplay_keyboard(t, minitel, shifted, caps_locked); + } + } + } + } +} + +send_move_msg(dir: string, ch: chan of string) +{ + ch <-= dir; +} + + +# Redisplay keyboard to reflect current state (shifted or unshifted) +redisplay_keyboard(t: ref Tk->Toplevel, minitel, shifted, caps_locked: int) +{ + base: int; + + if (shifted) + base = NKEYS; + else + base = 0; + + for(i:=0; i= int 'A' && val <= int 'Z') { + key = keys[n-NKEYS]; + } else if (val >= int 'a' && val <= int 'z') { + key = keys[n+NKEYS]; + } + } + + tk->cmd(t, ".b" + string i + " configure -text {" + key + + "} -command 'send keypress " + string val); + } + if (caps_locked) + tk->cmd(t, ".b" + string CAPSLOCKKEY + " configure -image Capslock_on"); + else + tk->cmd(t, ".b" + string CAPSLOCKKEY + " configure -image Capslock_off"); + tk->cmd(t, "update"); +} diff --git a/appl/examples/minitel/swkeyb.m b/appl/examples/minitel/swkeyb.m new file mode 100644 index 00000000..52206801 --- /dev/null +++ b/appl/examples/minitel/swkeyb.m @@ -0,0 +1,21 @@ +### +### This data and information is not to be used as the basis of manufacture, +### or be reproduced or copied, or be distributed to another party, in whole +### or in part, without the prior written consent of Lucent Technologies. +### +### (C) Copyright 1997 Lucent Technologies +### +### Written by N. W. Knauft +### + +# Revisions Copyright © 1998 Vita Nuova Limited. + +Keyboard: module +{ + PATH: con "/dis/wm/minitel/swkeyb.dis"; + + initialize: fn(t: ref Tk->Toplevel, ctxt : ref Draw->Context, + dot: string): chan of string; + chaninit: fn(t: ref Tk->Toplevel, ctxt : ref Draw->Context, + dot: string, rc: chan of string): chan of string; +}; diff --git a/appl/wm/minitel/README b/appl/wm/minitel/README deleted file mode 100644 index 82f3202e..00000000 --- a/appl/wm/minitel/README +++ /dev/null @@ -1,209 +0,0 @@ -Minitel Emulation for Inferno - -This directory contains the source of `miniterm', a minitel emulator -for Inferno. Miniterm is written in Limbo. The main components are: - - miniterm.m - common constants - miniterm.b - terminal emulator, messaging and Minitel `protocol` - event.[mb] - inter-module message format - keyb.b - Minitel keyboard module - modem.b - Minitel modem module - screen.b - Minitel screen module - socket.b - Minitel socket module - arg.m - basic command line argument handling - mdisplay.[mb] - Videotex display module - swkeyb.[mb] - Minitel aware software keyboard - - fonts.tgz which expands into: - - fonts/minitel - external and subfont directory (`bind -b' into /fonts) - fonts/minitel/f40x25 - 40 column external font - fonts/minitel/14x17 - fonts/minitel/14x17xoe - fonts/minitel/14x17arrow - fonts/minitel/f40x25g1 - 40 column semigraphic external font - fonts/minitel/vid14x17 - fonts/minitel/f40x25h - 40 column double height external font - fonts/minitel/14x34 - fonts/minitel/14x34xoe - fonts/minitel/14x34arrow - fonts/minitel/f40x25w - 40 column double width external font - fonts/minitel/28x17 - fonts/minitel/28x17xoe - fonts/minitel/28x17arrow - fonts/minitel/f40x25s - 40 column double size external font - fonts/minitel/28x34xoe - fonts/minitel/28x34arrow - fonts/minitel/f80x25 - 80 column external font - fonts/minitel/8x12 - fonts/minitel/8x12xoe - fonts/minitel/8x12arrow - -The fonts subdirectory should be bound into /fonts: - bind -b fonts /fonts -or the directory fonts/minitel copied to /fonts/minitel before invoking the emulator. -The names of the external fonts are -known to the Videotex display module. Similarly, the files: - /dev/modem - /dev/modemctl -are known to the modem module, but you can ignore them if -(as is almost certain) you are using the Internet-minitel gateway -and you haven't got appropriate modem hardware anyway. - -To build - mkdir /usr/inferno/dis/wm/minitel - mk install - -The code models the structure outlined in the Minitel 1B specification -provided by France Telecom. However, much more interpretation was -required to display the majority of screens currently seen on Minitel. -Additional information (although sketchy) was found on the Internet by -searching for Minitel or Videotex and also by examination of the codes -sent by minitel servers and experimenting with replies. There must be -some more up to date information somewhere! - -We don't support downloadable fonts, but correctly filter them out. - -The file miniterm.b contains the code for the minitel `terminal' with -which the other modules communicate. The keyboard, modem, socket, -screen and terminal are run as separate threads which communicate by -calling: - send(e: ref Event) -The clue to the intermodule communication is in Terminal.run which -does something like: - for(;;) { - ev =<- t.in => - eva := protocol(ev); - while(len eva > 0) { - post(eva[0]); - eva = eva[1:]; - } - # then deliver any `posted' messages (without blocking) - } -An Event `ev' may typically be an Edata type (say from the modem) or -an Eproto type for internal interpretation. In the call: - eva := protocol(ev) -The function protocol() dissects Edata messages to produce an inline -sequence of Edata and Eproto messages. The function post() queues -messages for delivery to the appropriate modules. For example, data -from the modem might be destined for the screen and the socket module. -Messages are queued until they can be delivered. That way the line: - ev =<- t.in -is executed in a timely way and the other modules can be written to -make blocking writes (via send()) and to service reads when they are -ready. - -In many places in the code lines appear with comments like: - if(p.skip < 1 || p.skip > 127) # 5.0 -These refer to sections of the Minitel specification which explain the -code. - -The mdisplay code provides a Videotex display using Inferno -primitives. The screen, keyboard and modem modules interpret data as -described in the equivalent section of the Minitel specification. The -socket module has not been implemented but currently performs a `null' -function and could easily be added if required. - - -- Namespace -We always expect the fonts to appear in /fonts and the softmodem -to appear as /dev/modem and /dev/modemctl. - -- Invocation -If invoked with no argument, miniterm uses the France Telecom -internet gateway by default (tcp!193.252.252.250!513). -If the argument starts with `modem' then -a direct connection through /dev/modem will be established. - -An argument beginning with anything other than `modem' will -be assumed to be an address suitable for dial(). For example: - - wm/minitel/miniterm tcp!193.252.252.250!513 - -will connect to the current France Telecom internet server. - -For direct connections a modem `init' string and an optional -phone number can follow the modem prefix, as in: - - wm/minitel/miniterm modem!F3!3615 - -or - - wm/minitel/miniterm modem!F3!01133836431414 - -The `F3' is the code which instructs the softmodem to enable V.23 -and needs to be passed when connecting to the FT servers. -To use pulse dialing instead of tone dialing the phone number -can be prefixed with a 'P' as in: - - wm/minitel/miniterm modem!F3!P3614 - -If the parameter specifies a network connection or a direct connection -with a phone number the software will attempt to connect immediately. -If Cx/Fin is used to disconnect and then re-connect it will use the -same IP address for a network connection or prompt for a new -phone number in the case of a direct connection. When prompting -for a new number the top row of the screen is used to allow the user -to edit the last used number. Simple editing is available, and the minitel -keys do the obvious things. - - - -** Notes on the 15th December 1998 Release ** - -- Software keyboard -A version of the software keyboard which understands some of -the minitel keyboard mappings is included. For example, hitting 'A' results -in a capital 'A' on the screen in spite of the Videotex case mapping. - -- Minitel function keys -The minitel keys are displayed on the right hand side of the screen -in 40 column mode on a network connection -and can be swapped to the left hand side by hitting the <- key. -In direct dial mode and 80 column network mode the keys are -displayed at the bottom of the screen. -In network mode they are re-displayed as appropriate on 40 to 80 -column mode changes. - - -Known Omission -------------- -- Error Correction (direct dial only) -There is no screen button to enable error correction in the release. -If a server asks for error correction it will be enabled. It looks as though -we need to include a key to enable it. Without it direct dial screens are -occasionally corrupted. - -- Software Keyboard Handling -We need to add some code to update the software keyboard and -bring it to the foreground on a mode change. - -- Full 80 column support -I am aware of some screens which don't look correct in 80 column -mode (and others that do). See `EMAIL' then choose USENET and -press SUITE a few times. I believe it behaves as specified but as we -have seen with the 40 column Videotex mode the specification -is not sufficient to display most of the minitel screens correctly. -80 column support needs just a little more work. -It may be, too, that the 80 column font could be made much more -readable by utilising a few more pixels on the screen now that we -are able to cover the toolbar. - -- Full toolbar integration -Experimentation will show whether there needs to be more -integration with the toolbar. - -Known Bugs ----------- -- Softmodem disconnection -Often, the modem does not hangup correctly. - -- Choose `USA' from a network connection -USA (from a network connection) gives an `iC' in bottom left hand -corner of screen. Possibly a server issue. Doesn't occur when -connecting directly. The server is really sending this sequence. -Both the FT emulator and their explorer plug-in suffer from it too. - - -John Bates -Vita Nuova Limited diff --git a/appl/wm/minitel/event.b b/appl/wm/minitel/event.b deleted file mode 100644 index f751f55b..00000000 --- a/appl/wm/minitel/event.b +++ /dev/null @@ -1,19 +0,0 @@ -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -Event.str(ev: self ref Event) : string -{ - s := "?"; - pick e := ev { - Edata => - s = sprint("Edata %d = ", len e.data); - for(i:=0; i - s = "Equit"; - Eproto => - s = sprint("Eproto %ux (%s)", e.cmd, e.s); - } - return s; -} diff --git a/appl/wm/minitel/event.m b/appl/wm/minitel/event.m deleted file mode 100644 index 1b524363..00000000 --- a/appl/wm/minitel/event.m +++ /dev/null @@ -1,19 +0,0 @@ -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -Event: adt { - path: int; # path for delivery - from: int; # sending module (for reply) - pick { - Edata => - data: array of byte; - Eproto => - cmd: int; - s: string; - a0, a1, a2: int; # parameters - Equit => - } - - str: fn(e: self ref Event) : string; # convert to readable form -}; diff --git a/appl/wm/minitel/keyb.b b/appl/wm/minitel/keyb.b deleted file mode 100644 index aba5485d..00000000 --- a/appl/wm/minitel/keyb.b +++ /dev/null @@ -1,367 +0,0 @@ -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -# special keyboard operations -Extend, # enable cursor and editing keys and control chars -C0keys, # cursor keys send BS,HT,LF and VT -Invert # case inversion - : con 1 << iota; - -Keyb: adt { - m: ref Module; # common attributes - in: chan of ref Event; - - cmd: chan of string; # from Tk (keypresses and focus) - spec: int; # special keyboard extensions - - init: fn(k: self ref Keyb, toplevel: ref Tk->Toplevel); - reset: fn(k: self ref Keyb); - run: fn(k: self ref Keyb); - quit: fn(k: self ref Keyb); - map: fn(k: self ref Keyb, key:int): array of byte; -}; - -Keyb.init(k: self ref Keyb, toplevel: ref Tk->Toplevel) -{ - k.in = chan of ref Event; - k.cmd = chan of string; - tk->namechan(toplevel, k.cmd, "keyb"); # Tk -> keyboard - k.reset(); -} - -Keyb.reset(k: self ref Keyb) -{ - k.m = ref Module(Pmodem|Psocket, 0); -} - -ask(in: chan of string, out: chan of string) -{ - keys: string; - - T.mode = Videotex; - S.setmode(Videotex); -# clear(S); - prompt: con "Numéroter: "; - number := M.lastdialstr; - S.msg(prompt); - -Input: - for(;;) { - n := len prompt + len number; - # guard length must be > len prompt - if (n > 30) - n -= 30; - else - n = 0; - S.msg(prompt + number[n:]); - keys = <- in; - if (keys == nil) - return; - - keys = canoncmd(keys); - - case keys { - "connect" or "send" => - break Input; - "correct" => - if(len number > 0) - number = number[0: len number -1]; - "cancel" => - number = ""; - break Input; - "repeat" or "index" or "guide" or "next" or "previous" => - ; - * => - number += keys; - } - } - - S.msg(nil); - for (;;) alt { - out <- = number => - return; - keys = <- in => - if (keys == nil) - return; - } -} - -Keyb.run(k: self ref Keyb) -{ - dontask := chan of string; - askchan := dontask; - askkeys := chan of string; -Runloop: - for(;;){ - alt { - ev := <- k.in => - pick e := ev { - Equit => - break Runloop; - Eproto => - case e.cmd { - Creset => - k.reset(); - Cproto => - case e.a0 { - START => - case e.a1 { - LOWERCASE => - k.spec |= Invert; - } - STOP => - case e.a1 { - LOWERCASE => - k.spec &= ~Invert; - } - } - * => break; - } - } - cmd := <- k.cmd => - if(debug['k'] > 0) { - fprint(stderr, "Tk %s\n", cmd); - } - (n, args) := sys->tokenize(cmd, " "); - if(n >0) - case hd args { - "key" => - (key, nil) := toint(hd tl args, 16); - if(askchan != dontask) { - s := minikey(key); - if (s == nil) - s[0] = key; - askkeys <-= s; - break; - } - keys := k.map(key); - if(keys != nil) { - send(ref Event.Edata(k.m.path, Mkeyb, keys)); - } - "skey" => # minitel key hit (soft key) - if(hd tl args == "Exit") { - if(askchan != dontask) { - askchan = dontask; - askkeys <-= nil; - } - if(T.state == Online || T.state == Connecting) { - seq := keyseq("connect"); - if(seq != nil) { - send(ref Event.Edata(k.m.path, Mkeyb, seq)); - send(ref Event.Edata(k.m.path, Mkeyb, seq)); - } - send(ref Event.Eproto(Pmodem, Mkeyb, Cdisconnect, "", 0,0,0)); - } - send(ref Event.Equit(0, 0)); - break; - } - if(askchan != dontask) { - askkeys <-= hd tl args; - break; - } - case hd tl args { - "Connect" => - case T.state { - Local => - if(M.connect == Network) - send(ref Event.Eproto(Pmodem, Mkeyb, Cconnect, "", 0,0,0)); - else { - askchan = chan of string; - spawn ask(askkeys, askchan); - } - Connecting => - send(ref Event.Eproto(Pmodem, Mkeyb, Cdisconnect, "", 0,0,0)); - Online => - seq := keyseq("connect"); - if(seq != nil) - send(ref Event.Edata(k.m.path, Mkeyb, seq)); - } - * => - seq := keyseq(hd tl args); - if(seq != nil) - send(ref Event.Edata(k.m.path, Mkeyb, seq)); - } - "click" => # fetch a word from the display - x := int hd tl args; - y := int hd tl tl args; - word := disp->GetWord(Point(x, y)); - if(word != nil) { - if (askchan != dontask) { - askkeys <- = word; - break; - } - if (T.state == Local) { - if (canoncmd(word) == "connect") { - if(M.connect == Network) - send(ref Event.Eproto(Pmodem, Mkeyb, Cconnect, "", 0,0,0)); - else { - askchan = chan of string; - spawn ask(askkeys, askchan); - } - break; - } - } - seq := keyseq(word); - if(seq != nil) - send(ref Event.Edata(k.m.path, Mkeyb, seq)); - else { - send(ref Event.Edata(k.m.path, Mkeyb, array of byte word )); - send(ref Event.Edata(k.m.path, Mkeyb, keyseq("send"))); - } - } - - } - dialstr := <-askchan => - askchan = dontask; - if(dialstr != nil) { - M.dialstr = dialstr; - send(ref Event.Eproto(Pmodem, Mkeyb, Cconnect, "", 0,0,0)); - } - } - } - send(nil); -} - - -# Perform mode specific key translation -# returns nil on invalid keypress, -Keyb.map(nil: self ref Keyb, key: int): array of byte -{ - # hardware to minitel keyboard mapping - cmd := minikey(key); - if (cmd != nil) { - seq := keyseq(cmd); - if(seq != nil) - return seq; - } - - # alphabetic (with case mapping) - case T.mode { - Videotex => - if(key >= 'A' && key <= 'Z') - return array [] of { byte ('a' + (key - 'A'))}; - if(key >= 'a' && key <= 'z') - return array [] of {byte ('A' + (key - 'a'))}; - Mixed or Ascii => - if(key >= 'A' && key <= 'Z' || key >= 'a' && key <= 'z') - return array [] of {byte key}; - }; - - # Numeric - if(key >= '0' && key <= '9') - return array [] of {byte key}; - - # Control-A -> Control-Z, Esc - columns 0 and 1 - if(key >= 16r00 && key <=16r1f) - case T.mode { - Videotex => - return nil; - Mixed or Ascii => - return array [] of {byte key}; - } - - # miscellaneous key mapping - case key { - 16r20 => ; # space - 16ra3 => return array [] of { byte 16r19, byte 16r23 }; # pound - '!' or '"' or '#' or '$' - or '%' or '&' or '\'' or '(' or ')' - or '*' or '+' or ',' or '-' - or '.' or ':' or ';' or '<' - or '=' or '>' or '?' or '@' => ; - KF13 => # request for error correction - usually Fnct M + C - if((M.spec&Ecp) == 0 && T.state == Online && T.connect == Direct) { -fprint(stderr, "requesting Ecp\n"); - return array [] of { byte SEP, byte 16r4a }; - } - return nil; - * => return nil; - } - return array [] of {byte key}; -} - -Keyb.quit(k: self ref Keyb) -{ - if(k==nil); -} - -canoncmd(s : string) : string -{ - s = tolower(s); - case s { - "connect" or "cx/fin" or - "connexion" or "fin" => return "connect"; - "send" or "envoi" => return "send"; - "repeat" or "repetition" => return "repeat"; - "index" or "sommaire" or "somm" - => return "index"; - "guide" => return "guide"; - "correct" or "correction" => return "correct"; - "cancel" or "annulation" or "annul" or "annu" - => return "cancel"; - "next" or "suite" => return "next"; - "previous" or "retour" or "retou" - => return "previous"; - } - return s; -} - -# map softkey names to the appropriate byte sequences -keyseq(skey: string): array of byte -{ - b2 := 0; - asterisk := 0; - if(skey == nil || len skey == 0) - return nil; - if(skey[0] == '*') { - asterisk = 1; - skey = skey[1:]; - } - skey = canoncmd(skey); - case skey { - "connect" => b2 = 16r49; - "send" => b2 = 16r41; - "repeat" => b2 = 16r43; - "index" => b2 = 16r46; - "guide" => b2 = 16r44; - "correct" => b2 = 16r47; - "cancel" => b2 = 16r45; - "next" => b2 = 16r48; - "previous" => b2 = 16r42; - } - if(b2) { - if(asterisk) - return array [] of { byte '*', byte SEP, byte b2}; - else - return array [] of { byte SEP, byte b2}; - } else - return nil; -} - -# map hardware or software keyboard presses to minitel functions -minikey(key: int): string -{ - case key { - Kup or KupPC => - return"previous"; - Kdown or KdownPC => - return "next"; - Kenter => - return "send"; - Kback => - return "correct"; - Kesc => - return "cancel"; - KF1 => - return "guide"; - KF2 => - return "connect"; - KF3 => - return "repeat"; - KF4 => - return "index"; - * => - return nil; - } -} \ No newline at end of file diff --git a/appl/wm/minitel/mdisplay.b b/appl/wm/minitel/mdisplay.b deleted file mode 100644 index b3c629f9..00000000 --- a/appl/wm/minitel/mdisplay.b +++ /dev/null @@ -1,799 +0,0 @@ -implement MDisplay; - -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# -# - best viewed with acme! - -include "sys.m"; -include "draw.m"; -include "mdisplay.m"; - -sys : Sys; -draw : Draw; - -Context, Point, Rect, Font, Image, Display, Screen : import draw; - - -# len cell == number of lines -# len cell[0] == number of cellmap cells per char -# (x,y)*cellsize == font glyph clipr - -cellS := array [] of {array [] of {(0, 0)}}; -cellW := array [] of {array [] of {(0, 0), (1, 0)}}; -cellH := array [] of {array [] of {(0, 1)}, array [] of {(0, 0)}}; -cellWH := array [] of {array [] of {(0, 1), (1, 1)}, array [] of {(0, 0), (1, 0)}}; - -Cellinfo : adt { - font : ref Font; - ch, attr : int; - clipmod : (int, int); -}; - - -# current display attributes -display : ref Display; -window : ref Image; -frames := array [2] of ref Image; -update : chan of int; - -colours : array of ref Image; -bright : ref Image; - -# current mode attributes -cellmap : array of Cellinfo; -nrows : int; -ncols : int; -ulheight : int; -curpos : Point; -winoff : Point; -cellsize : Point; -modeattr : con fgWhite | bgBlack; -showC := 0; -delims := 0; -modbbox := Rect((0,0),(0,0)); -blankrow : array of Cellinfo; - -ctxt : ref Context; -font : ref Font; # g0 videotex font - extended with unicode g2 syms -fonth : ref Font; # double height version of font -fontw : ref Font; # double width -fonts : ref Font; # double size -fontg1 : ref Font; # semigraphic videotex font (ch+128=separated) -fontfr : ref Font; # french character set -fontusa : ref Font; # american character set - - -Init(c : ref Context) : string -{ - sys = load Sys Sys->PATH; - draw = load Draw Draw->PATH; - - if (c == nil || c.display == nil) - return "no display context"; - - ctxt = c; - disp := ctxt.display; - - black := disp.rgb2cmap(0, 0, 0); - blue := disp.rgb2cmap(0, 0, 255); - red := disp.rgb2cmap(255, 0, 0); - magenta := disp.rgb2cmap(255, 0, 255); - green := disp.rgb2cmap(0, 255, 0); - cyan := disp.rgb2cmap(0, 255, 255); - yellow := disp.rgb2cmap(255, 255, 0); - white := disp.rgb2cmap(240, 240, 240); - - iblack := disp.color(black); - iblue := disp.color(blue); - ired := disp.color(red); - imagenta := disp.color(magenta); - igreen := disp.color(green); - icyan := disp.color(cyan); - iyellow := disp.color(yellow); - iwhite := disp.color(white); - - colours = array [] of { iblack, iblue, ired, imagenta, - igreen, icyan, iyellow, iwhite}; - bright = disp.color(disp.rgb2cmap(255, 255, 255)); - - update = chan of int; - spawn Update(update); - display = disp; - return nil; -} - -Quit() -{ - if (update != nil) - update <- = QuitUpdate; - update = nil; - window = nil; - frames[0] = nil; - frames[1] = nil; - cellmap = nil; - display = nil; -} - -Mode(r : Draw->Rect, w, h, ulh, d : int, fontpath : string) : (string, ref Draw->Image) -{ - if (display == nil) - # module not properly Init()'d - return ("not initialized", nil); - - curpos = Point(-1, -1); - if (window != nil) - update <- = Pause; - - cellmap = nil; - window = nil; - (dx, dy) := (r.dx(), r.dy()); - if (dx == 0 || dy == 0) { - return (nil, nil); - } - - black := display.rgb2cmap(0, 0, 0); - window = ctxt.screen.newwindow(r, Draw->Refbackup, black); - if (window == nil) - return ("cannot create window", nil); - - window.origin(Point(0,0), r.min); - winr := Rect((0,0), (dx, dy)); - frames[0] = display.newimage(winr, window.chans, 0, black); - frames[1] = display.newimage(winr, window.chans, 0, black); - - if (window == nil || frames[0] == nil || frames[1] == nil) { - window = nil; - return ("cannot allocate display resources", nil); - } - - ncols = w; - nrows = h; - ulheight = ulh; - delims = d; - showC = 0; - - cellmap = array [ncols * nrows] of Cellinfo; - - font = Font.open(display, fontpath); - fontw = Font.open(display, fontpath + "w"); - fonth = Font.open(display, fontpath + "h"); - fonts = Font.open(display, fontpath + "s"); - fontg1 = Font.open(display, fontpath + "g1"); - fontfr = Font.open(display, fontpath + "fr"); - fontusa = Font.open(display, fontpath + "usa"); - - if (font != nil) - cellsize = Point(font.width(" "), font.height); - else - cellsize = Point(dx/ncols, dy / nrows); - - winoff.x = (dx - (cellsize.x * ncols)) / 2; - winoff.y = (dy - (cellsize.y * nrows)) /2; - if (winoff.x < 0) - winoff.x = 0; - if (winoff.y < 0) - winoff.y = 0; - - blankrow = array [ncols] of {* => Cellinfo(font, ' ', modeattr | fgWhite, (0,0))}; - for (y := 0; y < nrows; y++) { - col0 := y * ncols; - cellmap[col0:] = blankrow; - } - -# frames[0].clipr = frames[0].r; -# frames[1].clipr = frames[1].r; -# frames[0].draw(frames[0].r, colours[0], nil, Point(0,0)); -# frames[1].draw(frames[1].r, colours[0], nil, Point(0,0)); -# window.draw(window.r, colours[0], nil, Point(0,0)); - update <- = Continue; - return (nil, window); -} - -Cursor(pt : Point) -{ - if (update == nil || cellmap == nil) - # update thread (cursor/character flashing) not running - return; - - # normalize pt - pt.x--; - - curpos = pt; - update <- = CursorSet; -} - -Put(str : string, pt : Point, charset, attr, insert : int) -{ - if (cellmap == nil || str == nil) - # nothing to do - return; - - # normalize pt - pt.x--; - - f : ref Font; - cell := cellS; - - case charset { - videotex => - if (!(attr & attrD)) - attr &= (fgMask | attrF | attrH | attrW | attrP); - if (attr & attrW && attr & attrH) { - cell = cellWH; - f = fonts; - } else if (attr & attrH) { - cell = cellH; - f = fonth; - } else if (attr & attrW) { - cell = cellW; - f = fontw; - } else { - f = font; - } - - semigraphic => - f = fontg1; - if (attr & attrL) { - # convert to "separated" - newstr := ""; - for (ix := 0; ix < len str; ix++) - newstr[ix] = str[ix] + 16r80; - str = newstr; - } - # semigraphic charset does not support size / polarity attributes - # attrD always set later once field attr established - attr &= ~(attrD | attrH | attrW | attrP | attrL); - - french => f = fontfr; - american => f = fontusa; - * => f = font; - } - - update <- = Pause; - - txty := pt.y - (len cell - 1); - for (cellix := len cell - 1; cellix >= 0; cellix--) { - y := pt.y - cellix; - - if (y < 0) - continue; - if (y >= nrows) - break; - - col0 := y * ncols; - colbase := pt.y * ncols; - - if (delims && !(attr & attrD)) { - # seek back for a delimiter - mask : int; - delimattr := modeattr; - - # semigraphics only inherit attrC from current field - if (charset == semigraphic) - mask = attrC; - else - mask = bgMask | attrC | attrL; - - for (ix := pt.x-1; ix >= 0; ix--) { - cix := ix + col0; - if (cellmap[cix].attr & attrD) { - if (cellmap[cix].font == fontg1 && f != fontg1) - # don't carry over attrL from semigraphic field - mask &= ~attrL; - - delimattr = cellmap[cix].attr; - break; - } - } - attr = (attr & ~mask) | (delimattr & mask); - - # semigraphics validate background colour - if (charset == semigraphic) - attr |= attrD; - } - - strlen := len cell[0] * len str; - gfxwidth := cellsize.x * strlen; - srco := Point(pt.x*cellsize.x, y*cellsize.y); - - if (insert) { - # copy existing cells and display to new position - if (pt.x + strlen < ncols) { - for (destx := ncols -1; destx > pt.x; destx--) { - srcx := destx - strlen; - if (srcx < 0) - break; - cellmap[col0 + destx] = cellmap[col0 + srcx]; - } - - # let draw() do the clipping for us - dsto := Point(srco.x + gfxwidth, srco.y); - dstr := Rect((dsto.x, srco.y), (ncols * cellsize.x, srco.y + cellsize.y)); - - frames[0].clipr = frames[0].r; - frames[1].clipr = frames[1].r; - frames[0].draw(dstr, frames[0], nil, srco); - frames[1].draw(dstr, frames[1], nil, srco); - if (modbbox.dx() == 0) - modbbox = dstr; - else - modbbox = boundingrect(modbbox, dstr); - } - } - - # copy-in new string - x := pt.x; - for (strix := 0; x < ncols && strix < len str; strix++) { - for (clipix := 0; clipix < len cell[cellix]; (x, clipix) = (x+1, clipix+1)) { - if (x < 0) - continue; - if (x >= ncols) - break; - cmix := col0 + x; - cellmap[cmix].font = f; - cellmap[cmix].ch = str[strix]; - cellmap[cmix].attr = attr; - cellmap[cmix].clipmod = cell[cellix][clipix]; - } - } - - # render the new string - txto := Point(srco.x, txty * cellsize.y); - strr := Rect(srco, (srco.x + gfxwidth, srco.y + cellsize.y)); - if (strr.max.x > ncols * cellsize.x) - strr.max.x = ncols * cellsize.x; - - drawstr(str, f, strr, txto, attr); - - # redraw remainder of line until find cell not needing redraw - - # this could be optimised by - # spotting strings with same attrs, font and clipmod pairs - # and write out whole string rather than processing - # a char at a time - - attr2 := attr; - mask := bgMask | attrC | attrL; - s := ""; - for (; delims && x < ncols; x++) { - if (x < 0) - continue; - newattr := cellmap[col0 + x].attr; - - if (cellmap[col0 + x].font == fontg1) { - # semigraphics act as bg colour delimiter - attr2 = (attr2 & ~bgMask) | (newattr & bgMask); - mask &= ~attrL; - } else - if (newattr & attrD) - break; - - if ((attr2 & mask) == (newattr & mask)) - break; - newattr = (newattr & ~mask) | (attr2 & mask); - cellmap[col0 + x].attr = newattr; - s[0] = cellmap[col0 + x].ch; - (cx, cy) := cellmap[col0 + x].clipmod; - f2 := cellmap[col0 + x].font; - - cellpos := Point(x * cellsize.x, y * cellsize.y); - clipr := Rect(cellpos, cellpos.add(Point(cellsize.x, cellsize.y))); - drawpt := cellpos.sub(Point(cx*cellsize.x, cy*cellsize.y)); - drawstr(s, f2, clipr, drawpt, newattr); - } - } - update <- = Continue; -} - -Scroll(topline, nlines : int) -{ - if (cellmap == nil || nlines == 0) - return; - - blankr : Rect; - scr := Rect((0,topline * cellsize.y), (ncols * cellsize.x, nrows * cellsize.y)); - - update <- = Pause; - - frames[0].clipr = scr; - frames[1].clipr = scr; - dstr := scr.subpt(Point(0, nlines * cellsize.y)); - - frames[0].draw(dstr, frames[0], nil, frames[0].clipr.min); - frames[1].draw(dstr, frames[1], nil, frames[1].clipr.min); - - if (nlines > 0) { - # scroll up - copy up from top - if (nlines > nrows - topline) - nlines = nrows - topline; - for (y := nlines + topline; y < nrows; y++) { - srccol0 := y * ncols; - dstcol0 := (y - nlines) * ncols; - cellmap[dstcol0:] = cellmap[srccol0:srccol0+ncols]; - } - for (y = nrows - nlines; y < nrows; y++) { - col0 := y * ncols; - cellmap[col0:] = blankrow; - } - blankr = Rect(Point(0, scr.max.y - (nlines * cellsize.y)), scr.max); - } else { - # scroll down - copy down from bottom - nlines = -nlines; - if (nlines > nrows - topline) - nlines = nrows - topline; - for (y := (nrows - 1) - nlines; y >= topline; y--) { - srccol0 := y * ncols; - dstcol0 := (y + nlines) * ncols; - cellmap[dstcol0:] = cellmap[srccol0:srccol0+ncols]; - } - for (y = topline; y < nlines; y++) { - col0 := y * ncols; - cellmap[col0:] = blankrow; - } - blankr = Rect(scr.min, (scr.max.x, scr.min.y + (nlines * cellsize.y))); - } - frames[0].draw(blankr, colours[0], nil, Point(0,0)); - frames[1].draw(blankr, colours[0], nil, Point(0,0)); - if (modbbox.dx() == 0) - modbbox = scr; - else - modbbox = boundingrect(modbbox, scr); - update <- = Continue; -} - -Reveal(show : int) -{ - showC = show; - if (cellmap == nil) - return; - - update <- = Pause; - for (y := 0; y < nrows; y++) { - col0 := y * ncols; - for (x := 0; x < ncols; x++) { - attr := cellmap[col0+x].attr; - if (!(attr & attrC)) - continue; - - s := ""; - s[0] = cellmap[col0 + x].ch; - (cx, cy) := cellmap[col0 + x].clipmod; - f := cellmap[col0 + x].font; - cellpos := Point(x * cellsize.x, y * cellsize.y); - clipr := Rect(cellpos, cellpos.add(Point(cellsize.x, cellsize.y))); - drawpt := cellpos.sub(Point(cx*cellsize.x, cy*cellsize.y)); - - drawstr(s, f, clipr, drawpt, attr); - } - } - update <- = Continue; -} - -# expects that pt.x already normalized -wordchar(pt : Point) : int -{ - if (pt.x < 0 || pt.x >= ncols) - return 0; - if (pt.y < 0 || pt.y >= nrows) - return 0; - - col0 := pt.y * ncols; - c := cellmap[col0 + pt.x]; - - if (c.attr & attrC && !showC) - # don't let clicking on screen 'reveal' concealed chars! - return 0; - - if (c.font == fontg1) - return 0; - - if (c.attr & attrW) { - # check for both parts of character - (modx, nil) := c.clipmod; - if (modx == 1) { - # rhs of char - check lhs is the same - if (pt.x <= 0) - return 0; - lhc := cellmap[col0 + pt.x-1]; - (lhmodx, nil) := lhc.clipmod; - if (!((lhc.attr & attrW) && (lhc.font == c.font) && (lhc.ch == c.ch) && (lhmodx == 0))) - return 0; - } else { - # lhs of char - check rhs is the same - if (pt.x >= ncols - 1) - return 0; - rhc := cellmap[col0 + pt.x + 1]; - (rhmodx, nil) := rhc.clipmod; - if (!((rhc.attr & attrW) && (rhc.font == c.font) && (rhc.ch == c.ch) && (rhmodx == 1))) - return 0; - } - } - if (c.ch >= 16r30 && c.ch <= 16r39) - # digits - return 1; - if (c.ch >= 16r41 && c.ch <= 16r5a) - # capitals - return 1; - if (c.ch >= 16r61 && c.ch <= 16r7a) - # lowercase - return 1; - if (c.ch == '*' || c.ch == '/') - return 1; - return 0; -} - -GetWord(gfxpt : Point) : string -{ - if (cellmap == nil) - return nil; - - scr := Rect((0,0), (ncols * cellsize.x, nrows * cellsize.y)); - gfxpt = gfxpt.sub(winoff); - - if (!gfxpt.in(scr)) - return nil; - - x := gfxpt.x / cellsize.x; - y := gfxpt.y / cellsize.y; - col0 := y * ncols; - - s := ""; - - # seek back - for (sx := x; sx >= 0; sx--) - if (!wordchar(Point(sx, y))) - break; - - if (sx++ == x) - return nil; - - # seek forward, constructing s - for (; sx < ncols; sx++) { - if (!wordchar(Point(sx, y))) - break; - c := cellmap[col0 + sx]; - s[len s] = c.ch; - if (c.attr & attrW) - sx++; - } - return s; -} - -Refresh() -{ - if (window == nil || modbbox.dx() == 0) - return; - - if (update != nil) - update <- = Redraw; -} - -framecolours(attr : int) : (ref Image, ref Image, ref Image, ref Image) -{ - fg : ref Image; - fgcol := attr & fgMask; - if (fgcol == fgWhite && attr & attrB) - fg = bright; - else - fg = colours[fgcol / fgBase]; - - bg : ref Image; - bgcol := attr & bgMask; - if (bgcol == bgWhite && attr & attrB) - bg = bright; - else - bg = colours[bgcol / bgBase]; - - (fg0, fg1) := (fg, fg); - (bg0, bg1) := (bg, bg); - - if (attr & attrP) - (fg0, bg0, fg1, bg1) = (bg1, fg1, bg0, fg0); - - if (attr & attrF) { - fg0 = fg; - fg1 = bg; - } - - if ((attr & attrC) && !showC) - (fg0, fg1) = (bg0, bg1); - return (fg0, bg0, fg1, bg1); -} - -kill(pid : int) -{ - prog := "/prog/" + string pid + "/ctl"; - fd := sys->open(prog, Sys->OWRITE); - if (fd != nil) { - cmd := array of byte "kill"; - sys->write(fd, cmd, len cmd); - } -} - -timer(ms : int, pc, tick : chan of int) -{ - pc <- = sys->pctl(0, nil); - for (;;) { - sys->sleep(ms); - tick <- = 1; - } -} - -# Update() commands -Redraw, Pause, Continue, CursorSet, QuitUpdate : con iota; - -Update(cmd : chan of int) -{ - flashtick := chan of int; - cursortick := chan of int; - pc := chan of int; - spawn timer(1000, pc, flashtick); - flashpid := <- pc; - spawn timer(500, pc, cursortick); - cursorpid := <- pc; - - cursor : Point; - showcursor := 0; - cursoron := 0; - quit := 0; - nultick := chan of int; - flashchan := nultick; - pcount := 1; - fgframe := 0; - - for (;!quit ;) alt { - c := <- cmd => - case c { - Redraw => - frames[0].clipr = frames[0].r; - frames[1].clipr = frames[1].r; - r := modbbox.addpt(winoff); - window.draw(r.addpt(window.r.min), frames[fgframe], nil, modbbox.min); - if (showcursor && cursoron) - drawcursor(cursor, fgframe, 1); - modbbox = Rect((0,0),(0,0)); - - Pause => - if (pcount++ == 0) - flashchan = nultick; - - Continue => - pcount--; - if (pcount == 0) - flashchan = flashtick; - - QuitUpdate => - quit++; - - CursorSet => - frames[0].clipr = frames[0].r; - frames[1].clipr = frames[1].r; - if (showcursor && cursoron) - drawcursor(cursor, fgframe, 0); - cursoron = 0; - if (curpos.x < 0 || curpos.x >= ncols || curpos.y < 0 || curpos.y >= nrows) - showcursor = 0; - else { - cursor = curpos; - showcursor = 1; - drawcursor(cursor, fgframe, 1); - cursoron = 1; - } - } - - <- flashchan => - # flip displays... - fgframe = (fgframe + 1 ) % 2; - modbbox = Rect((0,0),(0,0)); - frames[0].clipr = frames[0].r; - frames[1].clipr = frames[1].r; - window.draw(window.r.addpt(winoff), frames[fgframe], nil, Point(0,0)); - if (showcursor && cursoron) - drawcursor(cursor, fgframe, 1); - - <- cursortick => - if (showcursor) { - cursoron = !cursoron; - drawcursor(cursor, fgframe, cursoron); - } - } - kill(flashpid); - kill(cursorpid); -} - - -drawstr(s : string, f : ref Font, clipr : Rect, drawpt : Point, attr : int) -{ - (fg0, bg0, fg1, bg1) := framecolours(attr); - frames[0].clipr = clipr; - frames[1].clipr = clipr; - frames[0].draw(clipr, bg0, nil, Point(0,0)); - frames[1].draw(clipr, bg1, nil, Point(0,0)); - ulrect : Rect; - ul := (attr & attrL) && ! (attr & attrD); - - if (f != nil) { - if (ul) - ulrect = Rect((drawpt.x, drawpt.y + f.height - ulheight), (drawpt.x + clipr.dx(), drawpt.y + f.height)); - if (fg0 != bg0) { - frames[0].text(drawpt, fg0, Point(0,0), f, s); - if (ul) - frames[0].draw(ulrect, fg0, nil, Point(0,0)); - } - if (fg1 != bg1) { - frames[1].text(drawpt, fg1, Point(0,0), f, s); - if (ul) - frames[1].draw(ulrect, fg1, nil, Point(0,0)); - } - } - if (modbbox.dx() == 0) - modbbox = clipr; - else - modbbox = boundingrect(modbbox, clipr); -} - -boundingrect(r1, r2 : Rect) : Rect -{ - if (r2.min.x < r1.min.x) - r1.min.x = r2.min.x; - if (r2.min.y < r1.min.y) - r1.min.y = r2.min.y; - if (r2.max.x > r1.max.x) - r1.max.x = r2.max.x; - if (r2.max.y > r1.max.y) - r1.max.y = r2.max.y; - return r1; -} - -drawcursor(pt : Point, srcix, show : int) -{ - col0 := pt.y * ncols; - c := cellmap[col0 + pt.x]; - s := ""; - - s[0] = c.ch; - (cx, cy) := c.clipmod; - cellpos := Point(pt.x * cellsize.x, pt.y * cellsize.y); - clipr := Rect(cellpos, cellpos.add(Point(cellsize.x, cellsize.y))); - clipr = clipr.addpt(winoff); - clipr = clipr.addpt(window.r.min); - - drawpt := cellpos.sub(Point(cx*cellsize.x, cy*cellsize.y)); - drawpt = drawpt.add(winoff); - drawpt = drawpt.add(window.r.min); - - if (!show) { - # copy from appropriate frame buffer - window.draw(clipr, frames[srcix], nil, cellpos); - return; - } - - # invert colours - attr := c.attr ^ (fgMask | bgMask); - - fg, bg : ref Image; - f := c.font; - if (srcix == 0) - (fg, bg, nil, nil) = framecolours(attr); - else - (nil, nil, fg, bg) = framecolours(attr); - - prevclipr := window.clipr; - window.clipr = clipr; - - window.draw(clipr, bg, nil, Point(0,0)); - ulrect : Rect; - ul := (attr & attrL) && ! (attr & attrD); - - if (f != nil) { - if (ul) - ulrect = Rect((drawpt.x, drawpt.y + f.height - ulheight), (drawpt.x + clipr.dx(), drawpt.y + f.height)); - if (fg != bg) { - window.text(drawpt, fg, Point(0,0), f, s); - if (ul) - window.draw(ulrect, fg, nil, Point(0,0)); - } - } - window.clipr = prevclipr; -} diff --git a/appl/wm/minitel/mdisplay.m b/appl/wm/minitel/mdisplay.m deleted file mode 100644 index 24d7173f..00000000 --- a/appl/wm/minitel/mdisplay.m +++ /dev/null @@ -1,115 +0,0 @@ -# -# Minitel display handling module -# -# © 1998 Vita Nuova Limited. All rights reserved. -# - -MDisplay: module -{ - - PATH: con "/dis/wm/minitel/mdisplay.dis"; - - # Available character sets - videotex, semigraphic, french, american : con iota; - - # Fill() attributes bit mask - # - # DL CFPH WBbb bfff - # - # D = Delimiter (set "serial" attributes for rest of line) - # L = Lining (underlined text & "separated" graphics) - # C = Concealing - # F = Flashing - # P = polarity (1 = "inverse") - # H = double height - # W = double width (set H+W for double size) - # B = bright (0: fgwhite=lt.grey, 1: fgwhite=white) - # bbb = background colour - # fff = foreground colour - - fgBase : con 8r001; - bgBase : con 8r010; - attrBase : con 8r100; - - fgMask : con 8r007; - bgMask : con 8r070; - attrMask : con ~0 ^ (fgMask | bgMask); - - fgBlack, fgBlue, fgRed, fgMagenta, - fgGreen, fgCyan, fgYellow, fgWhite : con iota * fgBase; - - bgBlack, bgBlue, bgRed, bgMagenta, - bgGreen, bgCyan, bgYellow, bgWhite : con iota * bgBase; - - attrB, attrW, attrH, attrP, attrF, attrC, attrL, attrD : con attrBase << iota; - - # - # Init (ctxt) : string - # performs general module initialisation - # creates the display window of size/position r using the - # given display context. - # spawns refresh thread - # returns reason for error, or nil on success - # - # Mode(rect, width, height, ulheight, delims, fontpath) : (string, ref Draw->Image) - # set/reset display to given rectangle and character grid size - # ulheight == underline height from bottom of character cell - # if delims != 0 then "field" attrs for Put() are derived from - # preceding delimiter otherwise Put() attrs are taken as is - # - # load fonts: - # videotex - # w videotex double width - # h videotex double height - # s videotex double size - # g1 videotex semigraphics - # fr french character set - # usa american character set - # Note: - # charset g2 is not directly supported, instead the symbols - # of g2 that do not appear in g0 (standard videotex charset) - # are available in videotex font using unicode char codes. - # Therefore controlling s/w must map g2 codes to unicode. - # - # Cursor(pt) - # move cursor to given position - # row number (y) is 0 based - # column number (x) is 1 based - # move cursor off-screen to hide - # - # Put(str, pt, charset, attr, insert) - # render string str at position pt in the given character set - # using specified attributes. - # if insert is non-zero, all characters from given position to end - # of line are moved right by len str positions. - # - # Scroll(topline, nlines) - # move the whole displayby nlines (+ve = scroll up). - # exposed lines of display are set to spaces rendered with - # the current mode attribute flags. - # scroll region is from topline to bottom of display - # - # Reveal(reveal) - # reveal/hide all chars affected by Concealing attribute. - # - # Refresh() - # force screen update - # - # GetWord(pt) : string - # returns on-screen word at given graphics co-ords - # returns nil if blank or semigraphic charset at location - # - # Quit() - # undo Init() - - - Init : fn (ctxt : ref Draw->Context) : string; - Mode : fn (r : Draw->Rect, width, height, ulh, attr : int, fontpath : string) : (string, ref Draw->Image); - Cursor : fn (pt : Draw->Point); - Put : fn (str : string, pt : Draw->Point, chset, attr, insert : int); - Scroll : fn (topline, nlines : int); - Reveal : fn (reveal : int); - Refresh : fn (); - GetWord : fn (gfxpt : Draw->Point) : string; - Quit : fn (); -}; diff --git a/appl/wm/minitel/miniterm.b b/appl/wm/minitel/miniterm.b deleted file mode 100644 index 1c6ff759..00000000 --- a/appl/wm/minitel/miniterm.b +++ /dev/null @@ -1,1187 +0,0 @@ -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -implement Miniterm; - -include "sys.m"; - sys: Sys; - print, fprint, sprint, read: import sys; -include "draw.m"; - draw: Draw; -include "tk.m"; - tk: Tk; -include "tkclient.m"; - tkclient: Tkclient; - -include "miniterm.m"; - -Miniterm: module -{ - init: fn(ctxt: ref Draw->Context, argv: list of string); - -}; - -pgrp: int = 0; -debug: array of int = array[256] of {* => 0}; -stderr: ref Sys->FD; - -# Minitel terminal identification request - reply sequence -TERMINALID1 := array [] of { - byte SOH, - byte 'S', byte 'X', byte '1', byte 'H', byte 'N', - byte EOT -}; -TERMINALID2 := array [] of { - byte SOH, - byte 'C', byte 'g', byte '1', - byte EOT -}; - -# Minitel module identifiers -Mscreen, Mmodem, Mkeyb, Msocket, Nmodule: con iota; -Pscreen, Pmodem, Pkeyb, Psocket: con (1 << iota); -Modname := array [Nmodule] of { - Mscreen => "S", - Mmodem => "M", - Mkeyb => "K", - Msocket => "C", - * => "?", -}; - -# attributes common to all modules -Module: adt { - path: int; # bitset to connected modules - disabled: int; -}; - -# A BufChan queues events from the terminal to the modules -BufChan: adt { - path: int; # id bit - ch: chan of ref Event; # set to `in' or `dummy' channel - ev: ref Event; # next event to send - in: chan of ref Event; # real channel for Events to the device - q: array of ref Event; # subsequent events to send -}; - -# holds state information for the minitel `protocol` (chapter 6) -PState: adt { - state: int; - arg: array of int; # up to 3 arguments: X,Y,Z - nargs: int; # expected number of arguments - n: int; # progress - skip: int; # transparency; bytes to skip -}; -PSstart, PSesc, PSarg: con iota; # states - -# Terminal display modes -Videotex, Mixed, Ascii, - -# Connection methods -Direct, Network, - -# Terminal connection states -Local, Connecting, Online, - -# Special features -Echo - : con (1 << iota); - -Terminal: adt { - in: chan of ref Event; - out: array of ref BufChan; # buffered output to the minitel modules - - mode: int; # display mode - state: int; # connection state - spec: int; # special features - connect: int; # Direct, or Network - toplevel: ref Tk->Toplevel; - cmd: chan of string; # from Tk - proto: array of ref PState; # minitel protocol state - netaddr: string; # network address to dial - buttonsleft: int; # display buttons on the LHS (40 cols) - terminalid: array of byte; # ENQROM response - kbctl: chan of string; # softkeyboard control - kbmode: string; # softkeyboard mode - - init: fn(t: self ref Terminal, toplevel: ref Tk->Toplevel, connect: int); - run: fn(t: self ref Terminal, done: chan of int); - reset: fn(t: self ref Terminal); - quit: fn(t: self ref Terminal); - layout: fn(t: self ref Terminal, cols: int); - setkbmode: fn(t: self ref Terminal, tmode: int); -}; - -include "arg.m"; -include "event.m"; -include "event.b"; - -include "keyb.b"; -include "modem.b"; -include "socket.b"; -include "screen.b"; - -K: ref Keyb; -M: ref Modem; -C: ref Socket; -S: ref Screen; -T: ref Terminal; -Modules: array of ref Module; - - -init(ctxt: ref Draw->Context, argv: list of string) -{ - s: string; - netaddr: string = nil; - - sys = load Sys Sys->PATH; - tk = load Tk Tk->PATH; - tkclient = load Tkclient Tkclient->PATH; - tkclient->init(); - draw = load Draw Draw->PATH; - stderr = sys->fildes(2); - pgrp = sys->pctl(Sys->NEWPGRP|Sys->FORKNS, nil); - - arg := load Arg Arg->PATH; - arg->init(argv); - arg->setusage("miniterm [netaddr]"); - while((c := arg->opt()) != 0){ - case c { - 'D' => - s = arg->earg(); - for(i := 0; i < len s; i++){ - c = s[i]; - if(c < len debug) - debug[c] += 1; - } - * => - arg->usage(); - } - } - argv = arg->argv(); - if(len argv > 0) { - netaddr = hd argv; - argv = tl argv; - } - - if(argv != nil) - arg->usage(); - arg = nil; - - # usage: miniterm modem[!init[!number]] - # or miniterm tcp!a.b.c.d - connect: int; - initstr := dialstr := string nil; - if(netaddr == nil) - netaddr = "tcp!pdc.minitelfr.com!513"; # gateway - (nil, words) := sys->tokenize(netaddr, "!"); - if(len words == 0) { - connect = Direct; - words = "modem" :: nil; - } - if(hd words == "modem") { - connect = Direct; - words = tl words; - if(words != nil) { - initstr = hd words; - words = tl words; - if(words != nil) - dialstr = hd words; - } - if(initstr == "*") - initstr = nil; - if(dialstr == "*") - dialstr = nil; - } else { - connect = Network; - dialstr = netaddr; - } - - T = ref Terminal; - K = ref Keyb; - M = ref Modem; - C = ref Socket; - S = ref Screen; - Modules = array [Nmodule] of { - Mscreen => S.m, - Mmodem => M.m, - Mkeyb => K.m, - Msocket => C.m, - }; - - toplevel := tk->toplevel(ctxt.display, ""); - inittk(toplevel, connect); - - T.init(toplevel, connect); - K.init(toplevel); - M.init(connect, initstr, dialstr); - C.init(); - case connect { - Direct => - S.init(ctxt, Rect((0,0), (640,425)), Rect((0,0), (640,425))); - Network => - S.init(ctxt, Rect((0,0), (596,440)), Rect((0,50), (640,350))); - } - - done := chan of int; - spawn K.run(); - spawn M.run(); - spawn C.run(); - spawn S.run(); - spawn T.run(done); - <- done; - - # now tidy up - K.quit(); - M.quit(); - C.quit(); - S.quit(); - T.quit(); -} - -# the keyboard module handles keypresses and focus -BTN40x25: con "-height 24 -font {/fonts/lucidasans/unicode.6.font}"; -BTNCTL: con "-width 60 -height 20 -font {/fonts/lucidasans/unicode.7.font}"; -BTNMAIN: con "-width 80 -height 20 -font {/fonts/lucidasans/unicode.7.font}"; - -tkinitbs := array[] of { - "button .cxfin -text {Cx/Fin} -command {send keyb skey Connect}", - "button .done -text {Quitter} -command {send keyb skey Exit}", - "button .hup -text {Raccr.} -command {send term hangup}", - "button .somm -text {Somm.} -command {send keyb skey Index}", - "button .guide -text {Guide} -command {send keyb skey Guide}", - "button .annul -text {Annul.} -command {send keyb skey Cancel}", - "button .corr -text {Corr.} -command {send keyb skey Correct}", - "button .retour -text {Retour} -command {send keyb skey Previous}", - "button .suite -text {Suite} -command {send keyb skey Next}", - "button .repet -text {Répét.} -command {send keyb skey Repeat}", - "button .envoi -text {Envoi} -command {send keyb skey Send}", - "button .play -text {P} -command {send term play}", -# "button .db -text {D} -command {send term debug}" , - "button .kb -text {Clavier} -command {send term keyboard}", - "button .move -text {<-} -command {send term buttonsleft} " + BTN40x25, -}; - -tkinitdirect := array [] of { - ". configure -background black -height 480 -width 640", - - ".cxfin configure " + BTNCTL, - ".hup configure " + BTNCTL, - ".done configure " + BTNCTL, - ".somm configure " + BTNMAIN, - ".guide configure " + BTNMAIN, - ".annul configure " + BTNMAIN, - ".corr configure " + BTNMAIN, - ".retour configure " + BTNMAIN, - ".suite configure " + BTNMAIN, - ".repet configure " + BTNMAIN, - ".envoi configure " + BTNMAIN, -# ".play configure " + BTNCTL, -# ".db configure " + BTNCTL, - ".kb configure " + BTNCTL, - - "canvas .c -height 425 -width 640 -background black", - "bind .c {send term resize}", - "bind .c {send keyb key %K}", - "bind .c {send keyb focusin}", - "bind .c {send keyb focusout}", - "bind .c {focus .c; send keyb click %x %y}", - "frame .k -height 55 -width 640 -background black", - "pack propagate .k no", - "frame .klhs -background black", - "frame .krhs -background black", - "frame .krows -background black", - "frame .k1 -background black", - "frame .k2 -background black", - "pack .cxfin -in .klhs -anchor w -pady 4", - "pack .hup -in .klhs -anchor w", - "pack .somm .annul .retour .repet -in .k1 -side left -padx 2", - "pack .guide .corr .suite .envoi -in .k2 -side left -padx 2", - "pack .kb -in .krhs -anchor e -pady 4", - "pack .done -in .krhs -anchor e", - "pack .k1 -in .krows -pady 4", - "pack .k2 -in .krows", - "pack .klhs .krows .krhs -in .k -side left -expand 1 -fill x", - "pack .c .k", - "focus .c", - "update", -}; - -tkinitip := array [] of { - ". configure -background black -height 440 -width 640", - - # ip 40x25 mode support - "canvas .c40 -height 440 -width 596 -background black", - "bind .c40 {send term resize}", - "bind .c40 {send keyb key %K}", - "bind .c40 {send keyb focusin}", - "bind .c40 {send keyb focusout}", - "bind .c40 {focus .c40; send keyb click %x %y}", - "frame .k -height 427 -width 44 -background black", - "frame .gap1 -background black", - "frame .gap2 -background black", - "pack propagate .k no", - - # ip 80x25 mode support - "frame .padtop -height 50", - "canvas .c80 -height 300 -width 640 -background black", - "bind .c80 {send term resize}", - "bind .c80 {send keyb key %K}", - "bind .c80 {send keyb focusin}", - "bind .c80 {send keyb focusout}", - "bind .c80 {focus .c80; send keyb click %x %y}", - "frame .k80 -height 90 -width 640 -background black", - "pack propagate .k80 no", - "frame .klhs -background black", - "frame .krows -background black", - "frame .krow1 -background black", - "frame .krow2 -background black", - "frame .krhs -background black", - "pack .krow1 .krow2 -in .krows -pady 2", - "pack .klhs -in .k80 -side left", - "pack .krows -in .k80 -side left -expand 1", - "pack .krhs -in .k80 -side left", -}; - -tkip40x25show := array [] of { - ".cxfin configure " + BTN40x25, - ".hup configure " + BTN40x25, - ".done configure " + BTN40x25, - ".somm configure " + BTN40x25, - ".guide configure " + BTN40x25, - ".annul configure " + BTN40x25, - ".corr configure " + BTN40x25, - ".retour configure " + BTN40x25, - ".suite configure " + BTN40x25, - ".repet configure " + BTN40x25, - ".envoi configure " + BTN40x25, - ".play configure " + BTN40x25, -# ".db configure " + BTN40x25, - ".kb configure " + BTN40x25, - "pack .cxfin -in .k -side top -fill x", - "pack .gap1 -in .k -side top -expand 1", - "pack .guide .repet .somm .annul .corr .retour .suite .envoi -in .k -side top -fill x", - "pack .gap2 -in .k -side top -expand 1", - "pack .done .hup .kb .move -in .k -side bottom -pady 2 -fill x", -# "pack .db -in .k -side bottom", -}; - -tkip40x25lhs := array [] of { - ".move configure -text {->} -command {send term buttonsright}", - "pack .k .c40 -side left", - "focus .c40", - "update", -}; - -tkip40x25rhs := array [] of { - ".move configure -text {<-} -command {send term buttonsleft}", - "pack .c40 .k -side left", - "focus .c40", - "update", -}; - -tkip40x25hide := array [] of { - "pack forget .k .c40", -}; - -tkip80x25show := array [] of { - ".cxfin configure " + BTNCTL, - ".hup configure " + BTNCTL, - ".done configure " + BTNCTL, - ".somm configure " + BTNMAIN, - ".guide configure " + BTNMAIN, - ".annul configure " + BTNMAIN, - ".corr configure " + BTNMAIN, - ".retour configure " + BTNMAIN, - ".suite configure " + BTNMAIN, - ".repet configure " + BTNMAIN, - ".envoi configure " + BTNMAIN, -# ".play configure " + BTNCTL, -# ".db configure " + BTNCTL, - ".kb configure " + BTNCTL, - - "pack .cxfin .hup -in .klhs -anchor w -pady 2", - "pack .somm .annul .retour .repet -in .krow1 -side left -padx 2", - "pack .guide .corr .suite .envoi -in .krow2 -side left -padx 2", - "pack .done .kb -in .krhs -anchor e -pady 2", - "pack .padtop .c80 .k80 -side top", - "focus .c80", - "update", -}; - -tkip80x25hide := array [] of { - "pack forget .padtop .c80 .k80", -}; - -inittk(toplevel: ref Tk->Toplevel, connect: int) -{ - tkcmds(toplevel, tkinitbs); - if(connect == Direct) - tkcmds(toplevel, tkinitdirect); - else - tkcmds(toplevel, tkinitip); -} - -Terminal.layout(t: self ref Terminal, cols: int) -{ - if(t.connect == Direct) - return; - if(cols == 80) { - tkcmds(t.toplevel, tkip40x25hide); - tkcmds(t.toplevel, tkip80x25show); - } else { - tkcmds(t.toplevel, tkip80x25hide); - tkcmds(t.toplevel, tkip40x25show); - if (t.buttonsleft) - tkcmds(t.toplevel, tkip40x25lhs); - else - tkcmds(t.toplevel, tkip40x25rhs); - } -} - -Terminal.init(t: self ref Terminal, toplevel: ref Tk->Toplevel, connect: int) -{ - t.in = chan of ref Event; - t.proto = array [Nmodule] of { - Mscreen => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), - Mmodem => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), - Mkeyb => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), - Msocket => ref PState(PSstart, array [] of {0,0,0}, 0, 0, 0), - }; - - t.toplevel = toplevel; - t.connect = connect; - if (t.connect == Direct) - t.spec = 0; - else - t.spec = Echo; - t.cmd = chan of string; - tk->namechan(t.toplevel, t.cmd, "term"); # Tk -> terminal - t.state = Local; - t.buttonsleft = 0; - t.kbctl = nil; - t.kbmode = "minitel"; - t.reset(); -} - -Terminal.reset(t: self ref Terminal) -{ - t.mode = Videotex; -} - -Terminal.run(t: self ref Terminal, done: chan of int) -{ - t.out = array [Nmodule] of { - Mscreen => ref BufChan(Pscreen, nil, nil, S.in, array [0] of ref Event), - Mmodem => ref BufChan(Pmodem, nil, nil, M.in, array [0] of ref Event), - Mkeyb => ref BufChan(Pkeyb, nil, nil, K.in, array [0] of ref Event), - Msocket => ref BufChan(Psocket, nil, nil, C.in, array [0] of ref Event), - }; - modcount := Nmodule; - if(debug['P']) - post(ref Event.Eproto(Pmodem, 0, Cplay, "play", 0,0,0)); -Evloop: - for(;;) { - ev: ref Event = nil; - post(nil); - alt { - # recv message from one of the modules - ev =<- t.in => - if(ev == nil) { # modules ack Equit with nil - if(--modcount == 0) - break Evloop; - continue; - } - pick e := ev { - Equit => # close modules down - post(ref Event.Equit(Pscreen|Pmodem|Pkeyb|Psocket,0)); - continue; - } - - eva := protocol(ev); - while(len eva > 0) { - post(eva[0]); - eva = eva[1:]; - } - - # send message to `plumbed' modules - t.out[Mscreen].ch <- = t.out[Mscreen].ev => - t.out[Mscreen].ev = nil; - t.out[Mmodem].ch <- = t.out[Mmodem].ev => - t.out[Mmodem].ev = nil; - t.out[Mkeyb].ch <- = t.out[Mkeyb].ev => - t.out[Mkeyb].ev = nil; - t.out[Msocket].ch <- = t.out[Msocket].ev => - t.out[Msocket].ev = nil; - - # recv message from Tk - cmd := <- t.cmd => - (n, word) := sys->tokenize(cmd, " "); - if(n >0) - case hd word { - "resize" => ; - "play" => # for testing only - post(ref Event.Eproto(Pmodem, Mmodem, Cplay, "play", 0,0,0)); - "keyboard" => - if (t.kbctl == nil) { - e: string; - (e, t.kbctl) = kb(t); - if (e != nil) - sys->print("cannot start keyboard: %s\n", e); - } else - t.kbctl <- = "click"; - "hangup" => - if(T.state == Online || T.state == Connecting) - post(ref Event.Eproto(Pmodem, 0, Cdisconnect, "",0,0,0)); - "buttonsleft" => - tkcmds(t.toplevel, tkip40x25lhs); - t.buttonsleft = 1; - if(S.image != nil) - draw->(S.image.origin)(Point(0,0), Point(44, 0)); - if (t.kbctl != nil) - t.kbctl <- = "fg"; - "buttonsright" => - tkcmds(t.toplevel, tkip40x25rhs); - t.buttonsleft = 0; - if(S.image != nil) - draw->(S.image.origin)(Point(0,0), Point(0, 0)); - if (t.kbctl != nil) - t.kbctl <- = "fg"; - "debug" => - debug['s'] ^= 1; - debug['m'] ^= 1; - } - } - - } - if (t.kbctl != nil) - t.kbctl <- = "quit"; - t.kbctl = nil; - done <-= 0; -} - -kb(t: ref Terminal): (string, chan of string) -{ - s := chan of string; - spawn dokb(t, s); - e := <- s; - if (e != nil) - return (e, nil); - return (nil, s); -} - -Terminal.setkbmode(t: self ref Terminal, tmode: int) -{ - case tmode { - Videotex => - t.kbmode = "minitel"; - Mixed or Ascii => - t.kbmode = "standard"; - } - if(t.kbctl != nil) { - t.kbctl <-= "mode"; - t.kbctl <-= "fg"; - } -} - -include "swkeyb.m"; -dokb(t: ref Terminal, c: chan of string) -{ - keyboard := load Keyboard Keyboard->PATH; - if (keyboard == nil) { - c <- = "cannot load keyboard"; - return; - } - - kbctl := chan of string; - (top, m) := tkclient->toplevel(S.ctxt, "", "Keyboard", 0); - tk->cmd(top, "pack .Wm_t -fill x"); - tk->cmd(top, "update"); - keyboard->chaninit(top, S.ctxt, ".keys", kbctl); - tk->cmd(top, "pack .keys"); - - kbctl <-= t.kbmode ; - - kbon := 1; - c <- = nil; # all ok, we are now ready to accept commands - - for (;;) alt { - mcmd := <- m => - if (mcmd == "exit") { - if (kbon) { - tk->cmd(top, ". unmap; update"); - kbon = 0; - } - } else - tkclient->wmctl(top, mcmd); - kbcmd := <- c => - case kbcmd { - "fg" => - if (kbon) - tk->cmd(top, "raise .;update"); - "click" => - if (kbon) { - tk->cmd(top, ". unmap; update"); - kbon = 0; - } else { - tk->cmd(top, ". map; raise ."); - kbon = 1; - } - "mode" => - kbctl <- = t.kbmode; - "quit" => - kbctl <- = "kill"; - top = nil; - # ensure tkclient not blocked on a send to us (probably overkill!) - alt { - <- m => ; - * => ; - } - return; - } - } -} - - -Terminal.quit(nil: self ref Terminal) -{ -} - -# a minitel module sends an event to the terminal for routing -send(e: ref Event) -{ - if(debug['e'] && e != nil) - fprint(stderr, "%s: -> %s\n", Modname[e.from], e.str()); - T.in <- = e; -} - -# post an event to one or more modules -post(e: ref Event) -{ - i,l: int; - for(i=0; i 0) { - pick de := e { - * => - fprint(stderr, "[%s<-%s] %s\n", Modname[i], Modname[e.from], e.str()); - } - } - if(b.ev == nil) # nothing queued - b.ev = e; - else { # enqueue it - l = len b.q; - na := array [l+1] of ref Event; - na[0:] = b.q[0:]; - na[l] = e; - b.q = na; - } - } - } - # set a dummy channel if nothing to send - if(b.ev == nil) - b.ch = chan of ref Event; - else - b.ch = b.in; - } -} - -# run the terminal protocol -protocol(ev: ref Event): array of ref Event -{ - # Introduced by the following sequences, the minitel protocol can be - # embedded in any normal data sequence - # ESC,0x39,X - # ESC,0x3a,X,Y - # ESC,0x3b,X,Y,Z - # ESC,0x61 - cursor position request - - ea := array [0] of ref Event; # resulting sequence of Events - changed := 0; # if set, results are found in `ea' - - pick e := ev { - Edata => - d0 := 0; # offset of start of last data sequence - p := T.proto[e.from]; - for(i:=0; i 0) { # in transparency mode - if(ch == 0 && e.from == Mmodem) # 5.0 - continue; - p.skip--; - continue; - } - case p.state { - PSstart => - if(ch == ESC) { - p.state = PSesc; - changed = 1; - if(i > d0) - ea = eappend(ea, ref Event.Edata(e.path, e.from, e.data[d0:i])); - d0 = i+1; - } - PSesc => - p.state = PSarg; - p.n = 0; - d0 = i+1; - changed = 1; - if(ch >= 16r39 && ch <= 16r3b) #PRO1,2,3 - p.nargs = ch - 16r39 + 1; - else if(ch == 16r61) # cursor position request - p.nargs = 0; - else if(ch == ESC) { - ea = eappend(ea, ref Event.Edata(e.path, e.from, array [] of { byte ESC })); - p.state = PSesc; - } else { - # false alarm, restore as data - ea = eappend(ea, ref Event.Edata(e.path, e.from, array [] of { byte ESC, byte ch })); - p.state = PSstart; - } - PSarg => # expect `nargs' bytes - d0 = i+1; - changed =1; - if(p.n < p.nargs) - p.arg[p.n++] = ch; - if(p.n == p.nargs) { - # got complete protocol sequence - pe := proto(e.from, p); - if(pe != nil) - ea = eappend(ea, pe); - p.state = PSstart; - } - } - } - if(changed) { # some interpretation, results in `ea' - if(i > d0) - ea = eappend(ea, ref Event.Edata(e.path, e.from, e.data[d0:i])); - return ea; - } - ev = e; - return array [] of {ev}; - } - return array [] of {ev}; -} - -# append to an Event array -eappend(ea: array of ref Event, e: ref Event): array of ref Event -{ - l := len ea; - na := array [l+1] of ref Event; - na[0:] = ea[0:]; - na[l] = e; - return na; -} - -# act on a received protocol sequence -# some sequences are handled here by the terminal and result in a posted reply -# others are returned `inline' as Eproto events with the normal data stream. -proto(from: int, p: ref PState): ref Event -{ - if(debug['p']) { - fprint(stderr, "PRO%d: %ux", p.nargs, p.arg[0]); - if(p.nargs > 1) - fprint(stderr, " %ux", p.arg[1]); - if(p.nargs > 2) - fprint(stderr, " %ux", p.arg[2]); - fprint(stderr, " (%s)\n", Modname[from]); - } - case p.nargs { - 0 => # cursor position request ESC 0x61 - reply := array [] of { byte US, byte S.pos.y, byte S.pos.x }; - post(ref Event.Edata(Pmodem, from, reply)); - 1 => - case p.arg[0] { - PROTOCOLSTATUS => ; - ENQROM => # identification request - post(ref Event.Edata(Pmodem, from, T.terminalid)); - if(T.terminalid == TERMINALID1) - T.terminalid = TERMINALID2; - SETRAM1 or SETRAM2 => ; - FUNCTIONINGSTATUS => # 11.3 - PRO2(Pmodem, from, REPFUNCTIONINGSTATUS, osb()); - CONNECT => ; - DISCONNECT => - return ref Event.Eproto(Pscreen, from, Cscreenoff, "",0,0,0); - RESET => # reset the minitel terminal - all := Pscreen|Pmodem|Pkeyb|Psocket; - post(ref Event.Eproto(all, from, Creset, "",0,0,0)); # check - T.reset(); - reply := array [] of { byte SEP, byte 16r5E }; - post(ref Event.Edata(Pmodem, from, reply)); - } - 2 => - case p.arg[0] { - TO => # request for module status - PRO3(Pmodem, from, FROM, p.arg[1], psb(p.arg[1])); - NOBROADCAST => ; - BROADCAST => ; - TRANSPARENCY => # transparency mode - skip bytes - p.skip = p.arg[1]; - if(p.skip < 1 || p.skip > 127) # 5.0 - p.skip = 0; - else { - reply := array [] of { byte SEP, byte 16r57 }; - post(ref Event.Edata(Pmodem, from, reply)); - } - KEYBOARDSTATUS => - if(p.arg[1] == RxKeyb) - PRO3(Pmodem, from, REPKEYBOARDSTATUS, RxKeyb, kosb()); - START => - x := osb(); - if(p.arg[1] == PROCEDURE) - x |= 16r04; - if(p.arg[1] == SCROLLING) - x |= 16r02; - PRO2(Pmodem, from, REPFUNCTIONINGSTATUS, x); - case p.arg[1] { - PROCEDURE => # activate error correction procedure - sys->print("activate error correction\n"); - return ref Event.Eproto(Pmodem, from, Cstartecp, "",0,0,0); - SCROLLING => # set screen to scroll - return ref Event.Eproto(Pscreen, from, Cproto, "",START,SCROLLING,0); - LOWERCASE => # set keyb to invert case - return ref Event.Eproto(Pkeyb, from, Cproto, "",START,LOWERCASE,0); - } - STOP => - x := osb(); - if(p.arg[1] == SCROLLING) - x &= ~16r02; - PRO2(Pmodem, from, REPFUNCTIONINGSTATUS, osb()); - case p.arg[1] { - PROCEDURE => # deactivate error correction procedure - sys->print("deactivate error correction\n"); - return ref Event.Eproto(Pmodem, from, Cstopecp, "",0,0,0); - SCROLLING => # set screen to no scroll - return ref Event.Eproto(Pscreen, from, Cproto, "",STOP,SCROLLING,0); - LOWERCASE => # set keyb to not invert case - return ref Event.Eproto(Pkeyb, from, Cproto, "",STOP,LOWERCASE,0); - } - COPY => # copy screen to socket - # not implemented - ; - MIXED => # change video mode (12.1) - case p.arg[1] { - MIXED1 => # videotex -> mixed - reply := array [] of { byte SEP, byte 16r70 }; - return ref Event.Eproto(Pscreen, from, Cproto, "",MIXED,MIXED1,0); - MIXED2 => # mixed -> videotex - reply := array [] of { byte SEP, byte 16r71 }; - return ref Event.Eproto(Pscreen, from, Cproto, "",MIXED,MIXED2,0); - } - ASCII => # change video mode (12.2) - # TODO - ; - } - 3 => - case p.arg[0] { - OFF or ON => # link, unlink, enable, disable - modcmd(p.arg[0], p.arg[1], p.arg[2]); - PRO3(Pmodem, from, FROM, p.arg[1], psb(TxCode(p.arg[1]))); - START => - case p.arg[1] { - RxKeyb => # keyboard mode - case p.arg[2] { - ETEN => # extended keyboard - K.spec |= Extend; - C0 => # cursor control key coding from col 0 - K.spec |= C0keys; - } - PRO3(Pmodem, from, REPKEYBOARDSTATUS, RxKeyb, kosb()); - } - STOP => # keyboard mode - case p.arg[1] { - RxKeyb => # keyboard mode - case p.arg[2] { - ETEN => # extended keyboard - K.spec &= ~Extend; - C0 => # cursor control key coding from col 0 - K.spec &= ~C0keys; - } - PRO3(Pmodem, from, REPKEYBOARDSTATUS, RxKeyb, kosb()); - } - } - } - return nil; -} - -# post a PRO3 sequence to all modules on `path' -PRO3(path, from, x, y, z: int) -{ - data := array [] of { byte ESC, byte 16r3b, byte x, byte y, byte z}; - post(ref Event.Edata(path, from, data)); -} - -# post a PRO2 sequence to all modules on `path' -PRO2(path, from, x, y: int) -{ - data := array [] of { byte ESC, byte 16r3a, byte x, byte y}; - post(ref Event.Edata(path, from, data)); -} - -# post a PRO1 sequence to all modules on `path' -PRO1(path, from, x: int) -{ - data := array [] of { byte ESC, byte 16r39, byte x}; - post(ref Event.Edata(path, from, data)); -} - -# make or break links between modules, or enable and disable -modcmd(cmd, from, targ: int) -{ - from = RxTx(from); - targ = RxTx(targ); - if(from == targ) # enable or disable module - if(cmd == ON) - Modules[from].disabled = 0; - else - Modules[from].disabled = 1; - else # modify path - if(cmd == ON) - Modules[from].path |= (1< 0) { - if(b&1) - p ^= 1; - b >>= 1; - } - return p; -} - -# convert Rx or Tx code to a module code -RxTx(code: int): int -{ - rv := 0; - case code { - TxScreen or RxScreen => rv = Mscreen; - TxKeyb or RxKeyb => rv = Mkeyb; - TxModem or RxModem => rv = Mmodem; - TxSocket or RxSocket => rv = Msocket; - * => - fatal("invalid module code"); - } - return rv; -} - -# generate an operating status byte (11.2) -osb(): int -{ - b := 16r40; - if(S.cols == 80) - b |= 16r01; - if(S.spec & Scroll) - b |= 16r02; - if(M.spec & Ecp) - b |= 16r04; - if(K.spec & Invert) - b |= 16r08; -# if(parity(b)) -# b ^= 16r80; - return b; -} - -# generate a keyboard operating status byte (9.1.2) -kosb(): int -{ - b := 16r40; - if(K.spec & Extend) - b |= 16r01; - if(K.spec & C0keys) - b |= 16r04; -# if(parity(b)) -# b ^= 16r80; - return b; -} - -hex(v, n: int): string -{ - return sprint("%.*ux", n, v); -} - -tostr(ch: int): string -{ - str := ""; - str[0] = ch; - return str; -} - -toint(s: string, base: int): (int, string) -{ - if(base < 0 || base > 36) - return (0, s); - - c := 0; - for(i := 0; i < len s; i++) { - c = s[i]; - if(c != ' ' && c != '\t' && c != '\n') - break; - } - - neg := 0; - if(c == '+' || c == '-') { - if(c == '-') - neg = 1; - i++; - } - - ok := 0; - n := 0; - for(; i < len s; i++) { - c = s[i]; - v := base; - case c { - 'a' to 'z' => - v = c - 'a' + 10; - 'A' to 'Z' => - v = c - 'A' + 10; - '0' to '9' => - v = c - '0'; - } - if(v >= base) - break; - ok = 1; - n = n * base + v; - } - - if(!ok) - return (0, s); - if(neg) - n = -n; - return (n, s[i:]); -} - -tolower(s: string): string -{ - r := s; - for(i := 0; i < len r; i++) { - c := r[i]; - if(c >= int 'A' && c <= int 'Z') - r[i] = r[i] + (int 'a' - int 'A'); - } - return r; -} - -# duplicate `ch' exactly `n' times -dup(ch, n: int): string -{ - str := ""; - for(i:=0; iopen("#p/" + string pgrp + "/ctl", sys->OWRITE); - if(fd != nil) - sys->fprint(fd, "killgrp"); - exit; -} - -# Minitel byte MSB and LSB classification (p.87) -MSB(ch: int): int -{ - return (ch&16r70)>>4; -} -LSB(ch: int): int -{ - return (ch&16r0f); -} - -# Minitel character set classification (p.92) -ISC0(ch: int): int -{ - msb := (ch&16r70)>>4; - return msb == 0 || msb == 1; -} - -ISC1(ch: int): int -{ - return ch >= 16r40 && ch <= 16r5f; -} - -ISG0(ch: int): int -{ - # 0x20 (space) and 0x7f (DEL) are not in G0 - return ch > 16r20 && ch < 16r7f; -} - -tkcmds(t: ref Tk->Toplevel, cmds: array of string) -{ - n := len cmds; - for (ix := 0; ix < n; ix++) - tk->cmd(t, cmds[ix]); -} diff --git a/appl/wm/minitel/miniterm.m b/appl/wm/minitel/miniterm.m deleted file mode 100644 index e0345f81..00000000 --- a/appl/wm/minitel/miniterm.m +++ /dev/null @@ -1,120 +0,0 @@ -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -# Common control bytes -NUL: con 16r00; -SOH: con 16r01; -EOT: con 16r04; -ENQ: con 16r05; -BEL: con 16r07; -BS: con 16r08; -HT: con 16r09; -LF: con 16r0a; -VT: con 16r0b; -FF: con 16r0c; -CR: con 16r0d; -SO: con 16r0e; -SI: con 16r0f; -DLE: con 16r10; -CON: con 16r11; -XON: con 16r11; -REP: con 16r12; -SEP: con 16r13; -XOFF: con 16r13; -COFF: con 16r14; -NACK: con 16r15; -SYN: con 16r16; -CAN: con 16r18; -SS2: con 16r19; -SUB: con 16r1a; -ESC: con 16r1b; -SS3: con 16r1d; -RS: con 16r1e; -US: con 16r1f; - -SP: con 16r20; -DEL: con 16r7f; - -# Minitel Protocol - some are duplicated (chapter 6) -ASCII: con 16r31; -MIXED: con 16r32; -ETEN: con 16r41; -C0: con 16r43; -SCROLLING: con 16r43; -PROCEDURE: con 16r44; -LOWERCASE: con 16r45; -OFF: con 16r60; -ON: con 16r61; -TO: con 16r62; -FROM: con 16r63; -NOBROADCAST: con 16r64; -BROADCAST: con 16r65; -NONRETURN: con 16r64; -RETURN: con 16r65; -TRANSPARENCY: con 16r66; -DISCONNECT: con 16r67; -CONNECT: con 16r68; -START: con 16r69; -STOP: con 16r6a; -KEYBOARDSTATUS: con 16r72; -REPKEYBOARDSTATUS: con 16r73; -FUNCTIONINGSTATUS: con 16r72; -REPFUNCTIONINGSTATUS: con 16r73; -EXCHANGERATESTATUS: con 16r74; -REPEXCHANGERATESTATUS: con 16r75; -PROTOCOLSTATUS: con 16r76; -REPPROTOCOLSTATUS: con 16r77; -SETRAM1: con 16r78; -SETRAM2: con 16r79; -ENQROM: con 16r7b; -COPY: con 16r7c; -ASCII1: con 16r7d; -MIXED1: con 16r7d; -MIXED2: con 16r7e; -RESET: con 16r7f; - -# Module send and receive codes (chapter 6) -TxScreen: con 16r50; -TxKeyb: con 16r51; -TxModem: con 16r52; -TxSocket: con 16r53; -RxScreen: con 16r58; -RxKeyb: con 16r59; -RxModem: con 16r5a; -RxSocket: con 16r5b; - -# Internal Event.Eproto command constants -Cplay, # for testing -Cconnect, # e.s contains the address to dial -Cdisconnect, # -Crequestecp, # ask server to start ecp -Creset, # reset module -Cstartecp, # start error correction -Cstopecp, # stop error correction -Cproto, # minitel protocol -Ccursor, # update screen cursor -Cindicators, # update row 0 indicators - -# softmodem bug: Cscreenoff, Cscreenon -Cscreenoff, # screen: ignore data -Cscreenon, # screen: don't ignore data - -Clast - : con iota; - -# Special keys - hardware returned byte -KupPC: con 16r0203; # pc emu -KdownPC: con 16r0204; # pc emu -Kup: con 16rE012; -Kdown: con 16rE013; -Kenter: con 16r000a; -Kback: con 16r0008; -Kesc: con 16r001b; -KF1: con 16rE041; -KF2: con 16rE042; -KF3: con 16rE043; -KF4: con 16rE044; -KF13: con 16rE04D; - - diff --git a/appl/wm/minitel/mkfile b/appl/wm/minitel/mkfile deleted file mode 100644 index 16f816a6..00000000 --- a/appl/wm/minitel/mkfile +++ /dev/null @@ -1,24 +0,0 @@ -<../../../mkconfig - -TARG=\ - mdisplay.dis\ - miniterm.dis\ - swkeyb.dis\ - -MODULES=\ - mdisplay.m\ - miniterm.m\ - event.m\ - swkeyb.m\ - -SYSMODULES=\ - arg.m\ - sys.m\ - debug.m\ - draw.m\ - tk.m\ - wmlib.m\ - -DISBIN=$ROOT/dis/wm/minitel - -<$ROOT/mkfiles/mkdis diff --git a/appl/wm/minitel/modem.b b/appl/wm/minitel/modem.b deleted file mode 100644 index b7a21c1d..00000000 --- a/appl/wm/minitel/modem.b +++ /dev/null @@ -1,620 +0,0 @@ -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -#modem states for direct connection -MSstart, MSdialing, MSconnected, MSdisconnecting, - -# special features -Ecp # error correction - : con (1 << iota); - -Ecplen: con 17; # error correction block length: data[15], crc, validation (=0) - -Modem: adt { - m: ref Module; # common attributes - in: chan of ref Event; - - connect: int; # None, Direct, Network - state: int; # modem dialing state - saved: string; # response, so far (direct dial) - initstr: string; # softmodem init string (direct dial) - dialstr: string; # softmodem dial string (direct dial) - lastdialstr: string; - - spec: int; # special features - fd: ref Sys->FD; # modem data file, if != nil - cfd: ref Sys->FD; # modem ctl file, if != nil (direct dial only) - devpath: string; # path to the modem; - avail: array of byte; # already read - rd: chan of array of byte; # reader -> rd - pid: int; # reader pid if != 0 - - seq: int; # ECP block sequence number - waitsyn: int; # awaiting restart SYN SYN ... sequence - errforce: int; - addparity: int; # must add parity to outgoing data - - init: fn(m: self ref Modem, connect: int, initstr, dialstr: string); - reset: fn(m: self ref Modem); - run: fn(m: self ref Modem); - quit: fn(m: self ref Modem); - runstate: fn(m: self ref Modem, data: array of byte); - write: fn(m: self ref Modem, data: array of byte):int; # to network - reader: fn(m: self ref Modem, pidc: chan of int); -}; - -partab: array of byte; - -dump(a: array of byte, n: int): string -{ - s := sys->sprint("[%d]", n); - for(i := 0; i < n; i++) - s += sys->sprint(" %.2x", int a[i]); - return s; -} - -Modem.init(m: self ref Modem, connect: int, initstr, dialstr: string) -{ - partab = array[128] of byte; - for(c := 0; c < 128; c++) - if(parity(c)) - partab[c] = byte (c | 16r80); - else - partab[c] = byte c; - m.in = chan of ref Event; - m.connect = connect; - m.state = MSstart; - m.initstr = initstr; - m.dialstr = dialstr; - m.pid = 0; - m.spec = 0; - m.seq = 0; - m.waitsyn = 0; - m.errforce = 0; - m.addparity = 0; - m.avail = array[0] of byte; - m.rd = chan of array of byte; - m.reset(); -} - -Modem.reset(m: self ref Modem) -{ - m.m = ref Module(Pscreen, 0); -} - -Modem.run(m: self ref Modem) -{ - if(m.dialstr != nil) - send(ref Event.Eproto(Pmodem, Mmodem, Cconnect, "", 0,0,0)); -Runloop: - for(;;){ - alt { - ev := <- m.in => - pick e := ev { - Equit => - break Runloop; - Edata => - if(debug['m'] > 0) - fprint(stderr, "Modem <- %s\n", e.str()); - m.write(e.data); - if(T.state == Local || T.spec & Echo) { # loopback - if(e.from == Mkeyb) { - send(ref Event.Eproto(Pscreen, Mkeyb, Ccursor, "", 0,0,0)); - send(ref Event.Edata(Pscreen, Mkeyb, e.data)); - } - } - Eproto => - case e.cmd { - Creset => - m.reset(); - Cconnect => - if(m.pid != 0) - break; - m.addparity = 1; - T.state = Connecting; - send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); - - case m.connect { - Direct => - S.msg("Appel "+m.dialstr+" ..."); - dev := "/dev/modem"; - if(openmodem(m, dev) < 0) { - S.msg("Modem non prêt"); - T.state = Local; - send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); - break; - } - m.state = MSdialing; - m.saved = ""; - dialout(m); - T.terminalid = TERMINALID2; - Network => - S.msg("Connexion au serveur ..."); - if(debug['m'] > 0 || debug['M'] > 0) - sys->print("dial(%s)\n", m.dialstr); - (ok, cx) := sys->dial(m.dialstr, ""); - if (ok == -1){ - S.msg("Echec de la connexion"); - T.state = Local; - send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); - if(debug['m'] > 0) - sys->print("can't dial %s: %r\n", m.dialstr); - break; - } - m.fd = sys->open(cx.dir + "/data", Sys->ORDWR); - m.cfd = cx.cfd; - if(len m.dialstr >= 3 && m.dialstr[0:3] == "tcp") - m.addparity = 0; # Internet gateway apparently doesn't require parity - if(m.fd != nil) { - S.msg(nil); - m.state = MSconnected; - T.state = Online; - send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); - } - T.terminalid = TERMINALID1; - } - if(m.fd != nil) { - pidc := chan of int; - spawn m.reader(pidc); - m.pid = <-pidc; - } - Cdisconnect => - if(m.pid != 0) { - S.msg("Déconnexion ..."); - m.state = MSdisconnecting; - } - if(m.connect == Direct) - hangup(m); - else - nethangup(m); - Cplay => # for testing - case e.s { - "play" => - replay(m); - } - Crequestecp => - if(m.spec & Ecp){ # for testing: if already active, force an error - m.errforce = 1; - break; - } - m.write(array[] of {byte SEP, byte 16r4A}); -sys->print("sending request for ecp\n"); - Cstartecp => - m.spec |= Ecp; - m.seq = 0; # not in spec - m.waitsyn = 0; # not in spec - Cstopecp => - m.spec &= ~Ecp; - * => break; - } - } - b := <- m.rd => - if(debug['m'] > 0){ - fprint(stderr, "Modem -> %s\n", dump(b,len b)); - } - if(b == nil) { - m.pid = 0; - case m.state { - MSdialing => - S.msg("Echec appel"); - MSdisconnecting => - S.msg(nil); - } - m.state = MSstart; - T.state = Local; - send(ref Event.Eproto(Pscreen, Mmodem, Cscreenon, "",0,0,0)); - send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); - break; - } - m.runstate(b); - } - } - if(m.pid != 0) - kill(m.pid); - send(nil); -} - -Modem.quit(nil: self ref Modem) -{ -} - -Modem.runstate(m: self ref Modem, data: array of byte) -{ - if(debug['m']>0) - sys->print("runstate %d %s\n", m.state, dump(data, len data)); - case m.state { - MSstart => ; - MSdialing => - for(i:=0; i ; - Success => - S.msg(nil); - m.state = MSconnected; - T.state = Online; - send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); - Failure => - hangup(m); - S.msg(str); - m.state = MSstart; - T.state = Local; - send(ref Event.Eproto(Pscreen, Mmodem, Cindicators, "",0,0,0)); - } - m.saved = ""; - } - MSconnected => - send(ref Event.Edata(m.m.path, Mmodem, data)); - MSdisconnecting => ; - } -} - -Modem.write(m: self ref Modem, data: array of byte): int -{ - if(m.fd == nil) - return -1; - if(len data == 0) - return 0; - if(m.addparity){ - # unfortunately must copy data to add parity for direct modem connection - pa := array[len data] of byte; - for(i := 0; i0) - sys->print("WRITE %s\n", dump(data, len data)); - return sys->write(m.fd, data, len data); -} - -# -# minitel error correction protocol -# -# SYN, SYN, block number start of retransmission -# NUL ignored -# DLE escapes {DLE, SYN, NACK, NUL} -# NACK, block restart request -# - -crctab: array of int; -Crcpoly: con 16r9; # crc7 = x^7+x^3+1 - -# precalculate the CRC7 remainder for all bytes - -mktabs() -{ - crctab = array[256] of int; - for(c := 0; c < 256; c++){ - v := c; - crc := 0; - for(i := 0; i < 8; i++){ - crc <<= 1; # align remainder's MSB with value's - if((v^crc) & 16r80) - crc ^= Crcpoly; - v <<= 1; - } - crctab[c] = (crc<<1) & 16rFE; # pre-align the result to save <<1 later - } -} - -# return the index of the first non-NUL character (the start of a block) - -nextblock(a: array of byte, i: int, n: int): int -{ - for(; i < n; i++) - if(a[i] != byte NUL) - break; - return i; -} - -# return the data in the ecp block in a[0:Ecplen] (return nil for bad format) - -decode(a: array of byte): array of byte -{ - if(debug['M']>0) - sys->print("DECODE: %s\n", dump(a, Ecplen)); - badpar := 0; - oldcrc := int a[Ecplen-2]; - crc := 0; - op := 0; - dle := 0; - for(i:=0; i 0) - sys->print("bad parity\n"); - return nil; - } - crc = (crc>>1)&16r7F; - if(int partab[crc] != oldcrc){ - if(debug['E'] > 0) - sys->print("bad crc: in %ux got %ux\n", oldcrc, int partab[crc]); - return nil; - } - b := array[op] of byte; - b[0:] = a[0:op]; - if(debug['M'] > 0) - sys->print("OUT: %s [%x :: %x]\n", dump(b,op), crc, oldcrc); - return b; -} - -Modem.reader(m: self ref Modem, pidc: chan of int) -{ - pidc <-= sys->pctl(0, nil); - if(crctab == nil) - mktabs(); - a := array[Sys->ATOMICIO] of byte; - inbuf := 0; - while(m.fd != nil) { - while((n := read(m.fd, a[inbuf:], len a-inbuf)) > 0){ - n += inbuf; - inbuf = 0; - if((m.spec & Ecp) == 0){ - b := array[n] of byte; - for(i := 0; iprint("IN: %s\n", dump(a,n)); - i := 0; - if(m.waitsyn){ - sys->print("seeking SYN #%x\n", m.seq); - syn := byte (SYN | 16r80); - lim := n-3; - for(; i <= lim; i++) - if(a[i] == syn && a[i+1] == syn && (int a[i+2]&16r0F) == m.seq){ - i += 3; - m.waitsyn = 0; - sys->print("found SYN #%x@%d\n", m.seq, i-3); - break; - } - } - lim := n-Ecplen; - for(; (i = nextblock(a, i, n)) <= lim; i += Ecplen){ - b := decode(a[i:]); - if(m.errforce || b == nil){ - m.errforce = 0; - b = array[2] of byte; - b[0] = byte NACK; - b[1] = byte (m.seq | 16r40); - sys->print("NACK #%x\n", m.seq); - m.write(b); - m.waitsyn = 1; - i = n; # discard rest of block - break; - } - m.seq = (m.seq+1) & 16rF; # mod 16 counter - m.rd <-= b; - } - if(i < n){ - a[0:] = a[i:n]; - inbuf = n-i; - } - } - } - if(n <= 0) - break; - } -# m.fd = nil; - m.rd <-= nil; -} - -playfd: ref Sys->FD; -in_code, in_char: con iota; - -replay(m: ref Modem) -{ - buf := array[8192] of byte; - DMAX: con 10; - d := 0; - da := array[DMAX] of byte; - playfd = nil; - if(playfd == nil) - playfd = sys->open("minitel.txt", Sys->OREAD); - if(playfd == nil) - return; - nl := 1; - discard := 1; - state := in_code; - hs := ""; - start := 0; -mainloop: - for(;;) { - n := sys->read(playfd, buf, len buf); - if(n <= 0) - break; - for(i:=0; i' => discard = 0; - '<' => discard = 1; - if(start) - sys->sleep(1000); - '{' => start = 1; - '}' => break mainloop; - } - if(ch == '\n') - nl = 1; - else - nl = 0; - if(discard) - continue; - if(!start) - continue; - if(state == in_code && ((ch >= '0' && ch <= '9') || (ch >= 'a' && ch <= 'z'))) - hs[len hs] = ch; - else if(ch == '(') { - state = in_char; - (v, nil) := toint(hs, 16); - da[d++] = byte v; - if(d == DMAX) { - send(ref Event.Edata(m.m.path, Mmodem, da)); - d = 0; - da = array[DMAX] of byte; - sys->sleep(50); - } - hs = ""; - }else if(ch == ')') - state = in_code; - } - } - playfd = nil; - -} - -kill(pid : int) -{ - prog := "#p/" + string pid + "/ctl"; - fd := sys->open(prog, Sys->OWRITE); - if (fd != nil) { - cmd := array of byte "kill"; - sys->write(fd, cmd, len cmd); - } -} - - -# Modem stuff - - -# modem return codes -Ok, Success, Failure, Noise, Found: con iota; - -# -# modem return messages -# -Msg: adt { - text: string; - trans: string; - code: int; -}; - -msgs: array of Msg = array [] of { - ("OK", "Ok", Ok), - ("NO CARRIER", "No carrier", Failure), - ("ERROR", "Bad modem command", Failure), - ("NO DIALTONE", "No dial tone", Failure), - ("BUSY", "Busy tone", Failure), - ("NO ANSWER", "No answer", Failure), - ("CONNECT", "", Success), -}; - -msend(m: ref Modem, x: string): int -{ - a := array of byte x; - return sys->write(m.fd, a, len a); -} - -# -# apply a string of commands to modem -# -apply(m: ref Modem, s: string): int -{ - buf := ""; - for(i := 0; i < len s; i++){ - c := s[i]; - buf[len buf] = c; # assume no Unicode - if(c == '\r' || i == (len s -1)){ - if(c != '\r') - buf[len buf] = '\r'; - if(msend(m, buf) < 0) - return Failure; - buf = ""; - } - } - return Ok; -} - -openmodem(m: ref Modem, dev: string): int -{ - m.fd = sys->open(dev, Sys->ORDWR); - m.cfd = sys->open(dev+"ctl", Sys->ORDWR); - if(m.fd == nil || m.cfd == nil) - return -1; -# hangup(m); -# m.fd = sys->open(dev, Sys->ORDWR); -# m.cfd = sys->open(dev+"ctl", Sys->ORDWR); -# if(m.fd == nil || m.cfd == nil) -# return -1; - return 0; -} - -hangup(m: ref Modem) -{ - sys->sleep(1020); - msend(m, "+++"); - sys->sleep(1020); - apply(m, "ATH0"); - m.fd = nil; -# sys->write(m.cfd, array of byte "f", 1); - sys->write(m.cfd, array of byte "h", 1); - m.cfd = nil; - # HACK: shannon softmodem "off-hook" bug fix - sys->open("/dev/modem", Sys->OWRITE); -} - -nethangup(m: ref Modem) -{ - m.fd = nil; - sys->write(m.cfd, array of byte "hangup", 6); - m.cfd = nil; -} - - -# -# check `s' for a known reply or `substr' -# -seenreply(s: string): (int, string) -{ - for(k := 0; k < len msgs; k++) - if(len s >= len msgs[k].text && s[0:len msgs[k].text] == msgs[k].text) { - return (msgs[k].code, msgs[k].trans); - } - return (Noise, s); -} - -contains(s, t: string): int -{ - if(t == nil) - return 1; - if(s == nil) - return 0; - n := len t; - for(i := 0; i+n <= len s; i++) - if(s[i:i+n] == t) - return 1; - return 0; -} - -dialout(m: ref Modem) -{ - if(m.initstr != nil) - apply(m, "AT"+m.initstr); - if(m.dialstr != nil) { - apply(m, "ATD"+m.dialstr); - m.lastdialstr = m.dialstr; - m.dialstr = nil; - } -} diff --git a/appl/wm/minitel/screen.b b/appl/wm/minitel/screen.b deleted file mode 100644 index 4313d48d..00000000 --- a/appl/wm/minitel/screen.b +++ /dev/null @@ -1,1610 +0,0 @@ -# -# Occasional references are made to sections and tables in the -# France Telecom Minitel specification -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -include "mdisplay.m"; - -disp: MDisplay; - -Rect, Point : import Draw; - -# display character sets -videotex, semigraphic, french, american :import MDisplay; - -# display foreground colour attributes -fgBlack, fgBlue, fgRed, fgMagenta, -fgGreen, fgCyan, fgYellow, fgWhite :import MDisplay; - -# display background colour attributes -bgBlack, bgBlue, bgRed, bgMagenta, -bgGreen, bgCyan, bgYellow, bgWhite :import MDisplay; - -fgMask, bgMask : import MDisplay; - -# display formatting attributes -attrB, attrW, attrH, attrP, attrF, attrC, attrL, attrD :import MDisplay; - -# Initial attributes - white on black -ATTR0: con fgWhite|bgBlack&~(attrB|attrW|attrH|attrP|attrF|attrC|attrL|attrD); - -# special features -Cursor, Scroll, Insert - : con (1 << iota); - -# Screen states -Sstart, Sss2, Sesc, Srepeat, Saccent, Scsi0, Scsi1, Sus0, Sus1, Sskip, -Siso2022, Siso6429, Stransparent, Sdrcs, Sconceal, Swaitfor - : con iota; - -# Filter states -FSstart, FSesc, FSsep, FS6429, FS2022: con iota; - -Screen: adt { - m: ref Module; # common attributes - ctxt: ref Draw->Context; - in: chan of ref Event; # from the terminal - - image: ref Draw->Image; # Mdisplay image - dispr40, dispr80: Rect; # 40 and 80 column display region - oldtmode: int; # old terminal mode - rows: int; # number of screen rows (25 for minitel) - cols: int; # number of screen cols (40 or 80) - cset: int; # current display charset - - pos: Point; # current writing position (x:1, y:0) - attr: int; # display attribute set - spec: int; # special features - savepos: Point; # `pos' before moving to row zero - saveattr: int; # `attr' before moving to row zero - savech: int; # last character `Put' - delimit: int; # attr changed, make next space a delimiter - cursor: int; # update cursor soon - - state: int; # recogniser state - a0: int; # recogniser arg 0 - a1: int; # recogniser arg 1 - - fstate: int; # filter state - fsaved: array of byte; # filter `chars so far' - badp: int; # filter because of bad parameter - - ignoredata: int; # ignore data from - - init: fn(s: self ref Screen, ctxt: ref Draw->Context, r40, r80: Rect); - reset: fn(s: self ref Screen); - run: fn(s: self ref Screen); - quit: fn(s: self ref Screen); - setmode: fn(s: self ref Screen, tmode: int); - runstate: fn(s: self ref Screen, data: array of byte); - put: fn(s: self ref Screen, str: string); - msg: fn(s: self ref Screen, str: string); -}; - -Screen.init(s: self ref Screen, ctxt: ref Draw->Context, r40, r80: Rect) -{ - disp = load MDisplay MDisplay->PATH; - if(disp == nil) - fatal("can't load the display module: "+MDisplay->PATH); - - s.m = ref Module(0, 0); - s.ctxt = ctxt; - s.dispr40 = r40; - s.dispr80 = r80; - s.oldtmode = -1; - s.in = chan of ref Event; - disp->Init(s.ctxt); - s.reset(); - s.pos = Point(1, 1); - s.savech = 0; - s.cursor = 1; - s.ignoredata = 0; - s.fstate = FSstart; -} - -Screen.reset(s: self ref Screen) -{ - s.setmode(T.mode); - indicators(s); - s.state = Sstart; -} - -Screen.run(s: self ref Screen) -{ -Runloop: - for(;;) alt { - ev := <- s.in => - pick e := ev { - Equit => - break Runloop; - Eproto => - case e.cmd { - Creset => - s.reset(); - Cproto => - case e.a0 { - START => - case e.a1 { - SCROLLING => - s.spec |= Scroll; - } - STOP => - case e.a1 { - SCROLLING => - s.spec &= ~Scroll; - } - MIXED => - case e.a1 { - MIXED1 => # videotex -> mixed - if(T.mode != Mixed) - s.setmode(Mixed); - T.mode = Mixed; - MIXED2 => # mixed -> videotex - if(T.mode != Videotex) - s.setmode(Videotex); - T.mode = Videotex; - } - } - Ccursor => # update the cursor soon - s.cursor = 1; - Cindicators => - indicators(s); - Cscreenoff => - s.ignoredata = 1; - s.state = Sstart; - Cscreenon => - s.ignoredata = 0; - * => break; - } - Edata => - if(s.ignoredata) - continue; - oldpos := s.pos; - oldspec := s.spec; - da := filter(s, e.data); - while(len da > 0) { - s.runstate(da[0]); - da = da[1:]; - } - - if(s.pos.x != oldpos.x || s.pos.y != oldpos.y || (s.spec&Cursor)^(oldspec&Cursor)) - s.cursor = 1; - if(s.cursor) { - if(s.spec & Cursor) - disp->Cursor(s.pos); - else - disp->Cursor(Point(-1,-1)); - s.cursor = 0; - refresh(); - } else if(e.from == Mkeyb) - refresh(); - } - } - send(nil); -} - -# row0 indicators (1.2.2) -indicators(s: ref Screen) -{ - col: int; - ch: string; - - attr := fgWhite|bgBlack; - case T.state { - Local => - ch = "F"; - Connecting => - ch = "C"; - attr |= attrF; - Online => - ch = "C"; - } - if(s.cols == 40) { - col = 39; - attr |= attrP; - } else - col = 77; - disp->Put(ch, Point(col, 0), videotex, attr, 0); -} - -Screen.setmode(s: self ref Screen, tmode: int) -{ - dispr: Rect; - delims: int; - ulheight: int; - s.rows = 25; - s.spec = 0; - s.attr = s.saveattr = ATTR0; - s.delimit = 0; - s.pos = s.savepos = Point(-1, -1); - s.cursor = 1; - case tmode { - Videotex => - s.cset = videotex; - s.cols = 40; - dispr = s.dispr40; - delims = 1; - ulheight = 2; - s.pos = Point(1,1); - s.spec &= ~Cursor; - Mixed => -# s.cset = french; - s.cset = videotex; - s.cols = 80; - dispr = s.dispr80; - delims = 0; - ulheight = 1; - s.spec |= Scroll; - s.pos = Point(1, 1); - Ascii => - s.cset = french; - s.cols = 80; - dispr = s.dispr80; - delims = 0; - ulheight = 1; - }; - if(tmode != s.oldtmode) { - (nil, s.image) = disp->Mode(((0,0),(0,0)), 0, 0, 0, 0, nil); - T.layout(s.cols); - fontpath := sprint("/fonts/minitel/f%dx%d", s.cols, s.rows); - (nil, s.image) = disp->Mode(dispr, s.cols, s.rows, ulheight, delims, fontpath); - T.setkbmode(tmode); - } - disp->Reveal(0); # concealing enabled (1.2.2) - disp->Cursor(Point(-1,-1)); - s.oldtmode = tmode; -} - -Screen.quit(nil: self ref Screen) -{ - disp->Quit(); -} - -Screen.runstate(s: self ref Screen, data: array of byte) -{ - while(len data > 0) - case T.mode { - Videotex => - data = vstate(s, data); - Mixed => - data = mstate(s, data); - Ascii => - data = astate(s, data); - }; -} - -# process a byte from set C0 -vc0(s: ref Screen, ch: int) -{ - case ch { -# SOH => # not in spec, wait for 16r04 -# s.a0 = 16r04; -# s.state = Swaitfor; - SS2 => - s.state = Sss2; - SYN => - s.state = Sss2; # not in the spec, but acts like SS2 - ESC => - s.state = Sesc; - SO => - s.cset = semigraphic; - s.attr &= ~(attrH|attrW|attrP); # 1.2.4.2 - s.attr &= ~attrL; # 1.2.4.3 - SI => - s.cset = videotex; - s.attr &= ~attrL; # 1.2.4.3 - s.attr &= ~(attrH|attrW|attrP); # some servers seem to assume this too - SEP or SS3 => # 1.2.7 - s.state = Sskip; - BS => - if(s.pos.x == 1) { - if(s.pos.y == 0) - break; - if(s.pos.y == 1) - s.pos.y = s.rows - 1; - else - s.pos.y -= 1; - s.pos.x = s.cols; - } else - s.pos.x -= 1; - HT => - if(s.pos.x == s.cols) { - if(s.pos.y == 0) - break; - if(s.pos.y == s.rows - 1) - s.pos.y = 1; - else - s.pos.y += 1; - s.pos.x = 1; - } else - s.pos.x += 1; - LF => - if(s.pos.y == s.rows - 1) - if(s.spec&Scroll) - scroll(1, 1); - else - s.pos.y = 1; - else if(s.pos.y == 0) { # restore attributes on leaving row zero - s.pos = s.savepos; - s.attr = s.saveattr; - } else - s.pos.y += 1; - VT => - if(s.pos.y == 1) - if(s.spec&Scroll) - scroll(1, -1); - else - s.pos.y = s.rows - 1; - else if(s.pos.y == 0) - break; - else - s.pos.y -= 1; - CR => - s.pos.x = 1; - CAN => - cols := s.cols - s.pos.x + 1; - disp->Put(dup(' ', cols), Point(s.pos.x,s.pos.y), s.cset, s.attr, 0); - US => - # expect US row, col - s.state = Sus0; - FF => - s.cset = videotex; - s.attr = ATTR0; - s.pos = Point(1,1); - s.spec &= ~Cursor; - s.cursor = 1; - clear(s); - RS => - s.cset = videotex; - s.attr = ATTR0; - s.pos = Point(1,1); - s.spec &= ~Cursor; - s.cursor = 1; - CON => - s.spec |= Cursor; - s.cursor = 1; - COFF => - s.spec &= ~Cursor; - s.cursor = 1; - REP => - # repeat - s.state = Srepeat; - NUL => - # padding character - ignore, but may appear anywhere - ; - BEL => - # ah ... - ; - } -} - -# process a byte from the set c1 - introduced by the ESC character -vc1(s: ref Screen, ch: int) -{ - if(ISC0(ch)) { - s.state = Sstart; - vc0(s, ch); - return; - } - if(ch >= 16r20 && ch <= 16r2f) { - if(ch == 16r25) - s.state = Stransparent; - else if(ch == 16r23) - s.state = Sconceal; - else - s.state = Siso2022; - s.a0 = s.a1 = 0; - return; - } - - fg := bg := -1; - case ch { - 16r35 or - 16r36 or - 16r37 => - s.state = Sskip; # skip next char unless C0 - return; - - 16r5b => # CSI sequence - s.a0 = s.a1 = 0; - if(s.pos.y > 0) # 1.2.5.2 - s.state = Scsi0; - return; - - # foreground colour - 16r40 => fg = fgBlack; - 16r41 => fg = fgRed; - 16r42 => fg = fgGreen; - 16r43 => fg = fgYellow; - 16r44 => fg = fgBlue; - 16r45 => fg = fgMagenta; - 16r46 => fg = fgCyan; - 16r47 => fg = fgWhite; - - # background colour - 16r50 => bg = bgBlack; - 16r51 => bg = bgRed; - 16r52 => bg = bgGreen; - 16r53 => bg = bgYellow; - 16r54 => bg = bgBlue; - 16r55 => bg = bgMagenta; - 16r56 => bg = bgCyan; - 16r57 => bg = bgWhite; - - # flashing - 16r48 => s.attr |= attrF; - 16r49 => s.attr &= ~attrF; - - # conceal (serial attribute) - 16r58 => s.attr |= attrC; - s.delimit = 1; - 16r5f => s.attr &= ~attrC; - s.delimit = 1; - - # start lining (+separated graphics) (serial attribute) - 16r5a => s.attr |= attrL; - s.delimit = 1; - 16r59 => s.attr &= ~attrL; - s.delimit = 1; - - # reverse polarity - 16r5d => s.attr |= attrP; - 16r5c => s.attr &= ~attrP; - - # normal size - 16r4c => - s.attr &= ~(attrW|attrH); - - # double height - 16r4d => - if(s.pos.y < 2) - break; - s.attr &= ~(attrW|attrH); - s.attr |= attrH; - - # double width - 16r4e => - if(s.pos.y < 1) - break; - s.attr &= ~(attrW|attrH); - s.attr |= attrW; - - # double size - 16r4f => - if(s.pos.y < 2) - break; - s.attr |= (attrW|attrH); - } - if(fg >= 0) { - s.attr &= ~fgMask; - s.attr |= fg; - } - if(bg >= 0) { - s.attr &= ~bgMask; - s.attr |= bg; - s.delimit = 1; - } - s.state = Sstart; -} - - -# process a SS2 character -vss2(s: ref Screen, ch: int) -{ - if(ISC0(ch)) { - s.state = Sstart; - vc0(s, ch); - return; - } - case ch { - 16r41 or # grave # 5.1.2 - 16r42 or # acute - 16r43 or # circumflex - 16r48 or # umlaut - 16r4b => # cedilla - s.a0 = ch; - s.state = Saccent; - return; - 16r23 => ch = '£'; # Figure 2.8 - 16r24 => ch = '$'; - 16r26 => ch = '#'; - 16r27 => ch = '§'; - 16r2c => ch = 16rc3; # '←'; - 16r2d => ch = 16rc0; # '↑'; - 16r2e => ch = 16rc4; # '→'; - 16r2f => ch = 16rc5; # '↓'; - 16r30 => ch = '°'; - 16r31 => ch = '±'; - 16r38 => ch = '÷'; - 16r3c => ch = '¼'; - 16r3d => ch = '½'; - 16r3e => ch = '¾'; - 16r7a => ch = 'œ'; - 16r6a => ch = 'Œ'; - 16r7b => ch = 'ß'; - } - s.put(tostr(ch)); - s.savech = ch; - s.state = Sstart; -} - -# process CSI functions -vcsi(s: ref Screen, ch: int) -{ - case s.state { - Scsi0 => - case ch { - # move cursor up n rows, stop at top of screen - 'A' => - s.pos.y -= s.a0; - if(s.pos.y < 1) - s.pos.y = 1; - - # move cursor down n rows, stop at bottom of screen - 'B' => - s.pos.y += s.a0; - if(s.pos.y >= s.rows) - s.pos.y = s.rows - 1; - - # move cursor n columns right, stop at edge of screen - 'C' => - s.pos.x += s.a0; - if(s.pos.x > s.cols) - s.pos.x = s.cols; - - # move cursor n columns left, stop at edge of screen - 'D' => - s.pos.x -= s.a0; - if(s.pos.x < 1) - s.pos.x = 1; - - # direct cursor addressing - ';' => - s.state = Scsi1; - return; - - 'J' => - case s.a0 { - # clears from the cursor to the end of the screen inclusive - 0 => - rowclear(s.pos.y, s.pos.x, s.cols); - for(r:=s.pos.y+1; r - for(r:=1; r - clear(s); - } - - 'K' => - case s.a0 { - # clears from the cursor to the end of the row - 0 => rowclear(s.pos.y, s.pos.x, s.cols); - - # clears from the start of the row to the cursor - 1 => rowclear(s.pos.y, 1, s.pos.x); - - # clears the entire row in which the cursor is positioned - 2 => rowclear(s.pos.y, 1, s.cols); - } - - # deletes n characters from cursor position - 'P' => - rowclear(s.pos.y, s.pos.x, s.pos.x+s.a0-1); - - # inserts n characters from cursor position - '@' => - disp->Put(dup(' ', s.a0), Point(s.pos.x,s.pos.y), s.cset, s.attr, 1); - - # starts cursor insert mode - 'h' => - if(s.a0 == 4) - s.spec |= Insert; - - 'l' => # ends cursor insert mode - if(s.a0 == 4) - s.spec &= ~Insert; - - # deletes n rows from cursor row - 'M' => - scroll(s.pos.y, s.a0); - - # inserts n rows from cursor row - 'L' => - scroll(s.pos.y, -1*s.a0); - } - s.state = Sstart; - Scsi1 => - case ch { - # direct cursor addressing - 'H' => - if(s.a0 > 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) - s.pos = Point(s.a1, s.a0); - } - s.state = Sstart; - } -} - -# Screen state - Videotex mode -vstate(s: ref Screen, data: array of byte): array of byte -{ - i: int; - for(i = 0; i < len data; i++) { - ch := int data[i]; - - if(debug['s']) { - cs:=""; - if(s.cset==videotex) cs = "v"; else cs="s"; - fprint(stderr, "vstate %d, %ux (%c) %.4ux %.4ux %s (%d,%d)\n", s.state, ch, ch, s.attr, s.spec, cs, s.pos.y, s.pos.x); - } - case s.state { - Sstart => - if(ISG0(ch) || ch == SP) { - n := 0; - str := ""; - while(i < len data) { - ch = int data[i]; - if(ISG0(ch) || ch == SP) - str[n++] = int data[i++]; - else { - i--; - break; - } - } - if(n > 0) { - if(debug['s']) - fprint(stderr, "vstate puts(%s)\n", str); - s.put(str); - s.savech = str[n-1]; - } - } else if(ISC0(ch)) - vc0(s, ch); - else if(ch == DEL) { - if(s.cset == semigraphic) - ch = 16r5f; - s.put(tostr(ch)); - s.savech = ch; - } - Sss2 => - if(ch == NUL) # 1.2.6.1 - continue; - if(s.cset == semigraphic) # 1.2.3.4 - continue; - vss2(s, ch); - Sesc => - if(ch == NUL) - continue; - vc1(s, ch); - Srepeat => - # byte from `columns' 4 to 7 gives repeat count on 6 bits - # of the last `Put' character - if(ch == NUL) - continue; - if(ISC0(ch)) { - s.state = Sstart; - vc0(s, ch); - break; - } - if(ch >= 16r40 && ch <= 16r7f) - s.put(dup(s.savech, (ch-16r40))); - s.state = Sstart; - Saccent => - case s.a0 { - 16r41 => # grave - case ch { - 'a' => ch = 'à'; - 'e' => ch = 'è'; - 'u' => ch = 'ù'; - } - 16r42 => # acute - case ch { - 'e' => ch = 'é'; - } - 16r43 => # circumflex - case ch { - 'a' => ch = 'â'; - 'e' => ch = 'ê'; - 'i' => ch = 'î'; - 'o' => ch = 'ô'; - 'u' => ch = 'û'; - } - 16r48 => # umlaut - case ch { - 'a' => ch = 'ä'; - 'e' => ch = 'ë'; - 'i' => ch = 'ï'; - 'o' => ch = 'ö'; - 'u' => ch = 'ü'; - } - 16r4b => # cedilla - case ch { - 'c' => ch = 'ç'; - } - } - s.put(tostr(ch)); - s.savech = ch; - s.state = Sstart; - Scsi0 => - if(ch >= 16r30 && ch <= 16r39) { - s.a0 *= 10; - s.a0 += (ch - 16r30); - } else if((ch >= 16r20 && ch <= 16r29) || (ch >= 16r3a && ch <= 16r3f)) { # 1.2.7 - s.a0 = 0; - s.state = Siso6429; - } else - vcsi(s, ch); - Scsi1 => - if(ch >= 16r30 && ch <= 16r39) { - s.a1 *= 10; - s.a1 += (ch - 16r30); - } else - vcsi(s, ch); - Sus0 => - if(ch == 16r23) { # start DRCS definition - s.state = Sdrcs; - s.a0 = 0; - break; - } - if(ch >= 16r40 && ch < 16r80) - s.a0 = (ch - 16r40); - else if(ch >= 16r30 && ch <= 16r32) - s.a0 = (ch - 16r30); - else - s.a0 = -1; - s.state = Sus1; - Sus1 => - if(ch >= 16r40 && ch < 16r80) - s.a1 = (ch - 16r40); - else if(ch >= 16r30 && ch <= 16r39) { - s.a1 = (ch - 16r30); - s.a0 = s.a0*10 + s.a1; # shouldn't be used any more - s.a1 = 1; - } else - s.a1 = -1; - # US row, col : this is how you get to row zero - if(s.a0 >= 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) { - if(s.a0 == 0 && s.pos.y > 0) { - s.savepos = s.pos; - s.saveattr = s.attr; - } - s.pos = Point(s.a1, s.a0); - s.delimit = 0; # 1.2.5.3, don't reset serial attributes - s.attr = ATTR0; - s.cset = videotex; - } - s.state = Sstart; - Sskip => - # swallow the next character unless from C0 - s.state = Sstart; - if(ISC0(ch)) - vc0(s, ch); - Swaitfor => - # ignore characters until the character in a0 inclusive - if(ch == s.a0) - s.state = Sstart; - Siso2022 => - # 1.2.7 - # swallow (upto) 3 characters from column 2, - # then 1 character from columns 3 to 7 - if(ch == NUL) - continue; - if(ISC0(ch)) { - s.state = Sstart; - vc0(s, ch); - break; - } - s.a0++; - if(s.a0 <= 3) { - if(ch >= 16r20 && ch <= 16r2f) - break; - } - if (s.a0 <= 4 && ch >= 16r30 && ch <= 16r7f) { - s.state = Sstart; - break; - } - s.state = Sstart; - s.put(tostr(DEL)); - Siso6429 => - # 1.2.7 - # swallow characters from column 3, - # or column 2, then 1 from column 4 to 7 - if(ISC0(ch)) { - s.state = Sstart; - vc0(s, ch); - break; - } - if(ch >= 16r20 && ch <= 16r3f) - break; - if(ch >= 16r40 && ch <= 16r7f) { - s.state = Sstart; - break; - } - s.state = Sstart; - s.put(tostr(DEL)); - Stransparent => - # 1.2.7 - # ignore all codes until ESC, 25, 40 or ESC, 2F, 3F - # progress in s.a0 and s.a1 - match := array [] of { - array [] of { ESC, 16r25, 16r40 }, - array [] of { ESC, 16r2f, 16r3f }, - }; - if(ch == ESC) { - s.a0 = s.a1 = 1; - break; - } - if(ch == match[0][s.a0]) - s.a0++; - else - s.a0 = 0; - if(ch == match[1][s.a1]) - s.a1++; - else - s.a1 = 0; - if(s.a0 == 3 || s.a1 == 3) - s.state = Sstart; - Sdrcs => - if(s.a0 > 0) { # fixed number of bytes to skip in a0 - s.a0--; - if(s.a0 == 0) { - s.state = Sstart; - break; - } - } else if(ch == US) # US XX YY - end of DRCS - s.state = Sus0; - else if(ch == 16r20) # US 23 20 20 20 4[23] 49 - s.a0 = 4; - Sconceal => - # 1.2.4.4 - # ESC 23 20 58 - Conceal fields - # ESC 23 20 5F - Reveal fields - # ESC 23 21 XX - Filter - # progress in s.a0 - case s.a0 { - 0 => - if(ch == 16r20 || ch == 16r21) - s.a0 = ch; - 16r20 => - case ch { - 16r58 => - disp->Reveal(0); - disp->Refresh(); - 16r5f => - disp->Reveal(1); - disp->Refresh(); - } - s.state = Sstart; - 16r21 => - s.state = Sstart; - } - } - } - if (i < len data) - return data[i:]; - else - return nil; -} - -# Screen state - Mixed mode -mstate(s: ref Screen, data: array of byte): array of byte -{ - i: int; -Stateloop: - for(i = 0; i < len data; i++) { - ch := int data[i]; - - if(debug['s']) { - cs:=""; - if(s.cset==videotex) cs = "v"; else cs="s"; - fprint(stderr, "mstate %d, %ux (%c) %.4ux %.4ux %s (%d,%d)\n", s.state, ch, ch, s.attr, s.fstate, cs, s.pos.y, s.pos.x); - } - case s.state { - Sstart => - if(ISG0(ch) || ch == SP) { - n := 0; - str := ""; - while(i < len data) { - ch = int data[i]; - if(ISG0(ch) || ch == SP) - str[n++] = int data[i++]; - else { - i--; - break; - } - } - if(n > 0) { - if(debug['s']) - fprint(stderr, "mstate puts(%s)\n", str); - s.put(str); - s.savech = str[n-1]; - } - } else if(ISC0(ch)) - mc0(s, ch); - else if(ch == DEL) { - if(s.cset == semigraphic) - ch = 16r5f; - s.put(tostr(ch)); - s.savech = ch; - } - Sesc => - if(ch == NUL) - continue; - mc1(s, ch); - Scsi0 => - if(ch >= 16r30 && ch <= 16r39) { - s.a0 *= 10; - s.a0 += (ch - 16r30); - } else if(ch == '?') { - s.a0 = '?'; - } else - mcsi(s, ch); - if(T.mode != Mixed) # CSI ? { changes to Videotex mode - break Stateloop; - Scsi1 => - if(ch >= 16r30 && ch <= 16r39) { - s.a1 *= 10; - s.a1 += (ch - 16r30); - } else - mcsi(s, ch); - Sus0 => - if(ch >= 16r40 && ch < 16r80) - s.a0 = (ch - 16r40); - else if(ch >= 16r30 && ch <= 16r32) - s.a0 = (ch - 16r30); - else - s.a0 = -1; - s.state = Sus1; - Sus1 => - if(ch >= 16r40 && ch < 16r80) - s.a1 = (ch - 16r40); - else if(ch >= 16r30 && ch <= 16r39) { - s.a1 = (ch - 16r30); - s.a0 = s.a0*10 + s.a1; # shouldn't be used any more - s.a1 = 1; - } else - s.a1 = -1; - # US row, col : this is how you get to row zero - if(s.a0 >= 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) { - if(s.a0 == 0 && s.pos.y > 0) { - s.savepos = s.pos; - s.saveattr = s.attr; - } - s.pos = Point(s.a1, s.a0); - s.delimit = 0; # 1.2.5.3, don't reset serial attributes - s.attr = ATTR0; - s.cset = videotex; - } - s.state = Sstart; - Siso6429 => - # 1.2.7 - # swallow characters from column 3, - # or column 2, then 1 from column 4 to 7 - if(ISC0(ch)) { - s.state = Sstart; - mc0(s, ch); - break; - } - if(ch >= 16r20 && ch <= 16r3f) - break; - if(ch >= 16r40 && ch <= 16r7f) { - s.state = Sstart; - break; - } - s.state = Sstart; - s.put(tostr(DEL)); - } - } - if (i < len data) - return data[i:]; - else - return nil; - return nil; -} - -# process a byte from set C0 - Mixed mode -mc0(s: ref Screen, ch: int) -{ - case ch { - ESC => - s.state = Sesc; - SO => -# s.cset = french; - ; - SI => -# s.cset = american; - ; - BS => - if(s.pos.x > 1) - s.pos.x -= 1; - HT => - s.pos.x += 8; - if(s.pos.x > s.cols) - s.pos.x = s.cols; - LF or VT or FF => - if(s.pos.y == s.rows - 1) - if(s.spec&Scroll) - scroll(1, 1); - else - s.pos.y = 1; - else if(s.pos.y == 0) { # restore attributes on leaving row zero - if(ch == LF) { # 4.5 - s.pos = s.savepos; - s.attr = s.saveattr; - } - } else - s.pos.y += 1; - CR => - s.pos.x = 1; - CAN or SUB => # displays the error symbol - filled in rectangle - disp->Put(dup(16r5f, 1), Point(s.pos.x,s.pos.y), s.cset, s.attr, 0); - NUL => - # padding character - ignore, but may appear anywhere - ; - BEL => - # ah ... - ; - XON => # screen copying - ; - XOFF => # screen copying - ; - US => - # expect US row, col - s.state = Sus0; - } -} - -# process a byte from the set c1 - introduced by the ESC character - Mixed mode -mc1(s: ref Screen, ch: int) -{ - if(ISC0(ch)) { - s.state = Sstart; - mc0(s, ch); - return; - } - case ch { - 16r5b => # CSI sequence - s.a0 = s.a1 = 0; - if(s.pos.y > 0) # 1.2.5.2 - s.state = Scsi0; - return; - - 16r44 or # IND like LF - 16r45 => # NEL like CR LF - if(ch == 16r45) - s.pos.x = 1; - if(s.pos.y == s.rows - 1) - if(s.spec&Scroll) - scroll(1, 1); - else - s.pos.y = 1; - else if(s.pos.y == 0) { # restore attributes on leaving row zero - s.pos = s.savepos; - s.attr = s.saveattr; - } else - s.pos.y += 1; - 16r4d => # RI - if(s.pos.y == 1) - if(s.spec&Scroll) - scroll(1, -1); - else - s.pos.y = s.rows - 1; - else if(s.pos.y == 0) - break; - else - s.pos.y -= 1; - } - s.state = Sstart; -} - - -# process CSI functions - Mixed mode -mcsi(s: ref Screen, ch: int) -{ - case s.state { - Scsi0 => - case ch { - # move cursor up n rows, stop at top of screen - 'A' => - if(s.a0 == 0) - s.a0 = 1; - s.pos.y -= s.a0; - if(s.pos.y < 1) - s.pos.y = 1; - - # move cursor down n rows, stop at bottom of screen - 'B' => - if(s.a0 == 0) - s.a0 = 1; - s.pos.y += s.a0; - if(s.pos.y >= s.rows) - s.pos.y = s.rows - 1; - - # move cursor n columns right, stop at edge of screen - 'C' => - if(s.a0 == 0) - s.a0 = 1; - s.pos.x += s.a0; - if(s.pos.x > s.cols) - s.pos.x = s.cols; - - # move cursor n columns left, stop at edge of screen - 'D' => - if(s.a0 == 0) - s.a0 = 1; - s.pos.x -= s.a0; - if(s.pos.x < 1) - s.pos.x = 1; - - # second parameter - ';' => - s.state = Scsi1; - return; - - 'J' => - case s.a0 { - # clears from the cursor to the end of the screen inclusive - 0 => - rowclear(s.pos.y, s.pos.x, s.cols); - for(r:=s.pos.y+1; r - for(r:=1; r - clear(s); - } - - 'K' => - case s.a0 { - # clears from the cursor to the end of the row - 0 => rowclear(s.pos.y, s.pos.x, s.cols); - - # clears from the start of the row to the cursor - 1 => rowclear(s.pos.y, 1, s.pos.x); - - # clears the entire row in which the cursor is positioned - 2 => rowclear(s.pos.y, 1, s.cols); - } - - # inserts n characters from cursor position - '@' => - disp->Put(dup(' ', s.a0), Point(s.pos.x,s.pos.y), s.cset, s.attr, 1); - - # starts cursor insert mode - 'h' => - if(s.a0 == 4) - s.spec |= Insert; - - 'l' => # ends cursor insert mode - if(s.a0 == 4) - s.spec &= ~Insert; - - # inserts n rows from cursor row - 'L' => - scroll(s.pos.y, -1*s.a0); - s.pos.x = 1; - - # deletes n rows from cursor row - 'M' => - scroll(s.pos.y, s.a0); - s.pos.x = 1; - - # deletes n characters from cursor position - 'P' => - rowclear(s.pos.y, s.pos.x, s.pos.x+s.a0-1); - - # select Videotex mode - '{' => - if(s.a0 == '?') { - T.mode = Videotex; - s.setmode(T.mode); - } - - # display attributes - 'm' => - case s.a0 { - 0 => s.attr &= ~(attrL|attrF|attrP|attrB); - 1 => s.attr |= attrB; - 4 => s.attr |= attrL; - 5 => s.attr |= attrF; - 7 => s.attr |= attrP; - 22 => s.attr &= ~attrB; - 24 => s.attr &= ~attrL; - 25 => s.attr &= ~attrF; - 27 => s.attr &= ~attrP; - } - # direct cursor addressing - 'H' => - if(s.a0 == 0) - s.a0 = 1; - if(s.a1 == 0) - s.a1 = 1; - if(s.a0 > 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) - s.pos = Point(s.a1, s.a0); - } - s.state = Sstart; - Scsi1 => - case ch { - # direct cursor addressing - 'H' => - if(s.a0 == 0) - s.a0 = 1; - if(s.a1 == 0) - s.a1 = 1; - if(s.a0 > 0 && s.a0 < s.rows && s.a1 > 0 && s.a1 <= s.cols) - s.pos = Point(s.a1, s.a0); - } - s.state = Sstart; - } -} - - -# Screen state - ASCII mode -astate(nil: ref Screen, nil: array of byte): array of byte -{ - return nil; -} - -# Put a string in the current attributes to the current writing position -Screen.put(s: self ref Screen, str: string) -{ - while((l := len str) > 0) { - n := s.cols - s.pos.x + 1; # characters that will fit on this row - if(s.attr & attrW) { - if(n > 1) # fit normal width character in last column - n /= 2; - } - if(n > l) - n = l; - if(s.delimit) { # set delimiter bit on 1st space (if any) - for(i:=0; i 0) { - disp->Put(str[0:i], s.pos, s.cset, s.attr, s.spec&Insert); - incpos(s, i); - } - if(i < n) { - if(debug['s']) { - cs:=""; - if(s.cset==videotex) cs = "v"; else cs="s"; - fprint(stderr, "D %ux %s\n", s.attr|attrD, cs); - } - disp->Put(tostr(str[i]), s.pos, s.cset, s.attr|attrD, s.spec&Insert); - incpos(s, 1); - s.delimit = 0; - # clear serial attributes once used - # hang onto background attribute - needed for semigraphics - case s.cset { - videotex => - s.attr &= ~(attrL|attrC); - semigraphic => - s.attr &= ~(attrC); - } - } - if(i < n-1) { - disp->Put(str[i+1:n], s.pos, s.cset, s.attr, s.spec&Insert); - incpos(s, n-(i+1)); - } - } else { - disp->Put(str[0:n], s.pos, s.cset, s.attr, s.spec&Insert); - incpos(s, n); - } - if(n < len str) - str = str[n:]; - else - str = nil; - } -# if(T.state == Local || T.spec&Echo) -# refresh(); -} - -# increment the current writing position by `n' cells. -# caller must ensure that `n' characters can fit -incpos(s: ref Screen, n: int) -{ - if(s.attr & attrW) - s.pos.x += 2*n; - else - s.pos.x += n; - if(s.pos.x > s.cols) - if(s.pos.y == 0) # no wraparound from row zero - s.pos.x = s.cols; - else { - s.pos.x = 1; - if(s.pos.y == s.rows - 1 && s.spec&Scroll) { - if(s.attr & attrH) { - scroll(1, 2); - } else { - scroll(1, 1); - rowclear(s.pos.y, 1, s.cols); - } - } else { - if(s.attr & attrH) - s.pos.y += 2; - else - s.pos.y += 1; - if(s.pos.y >= s.rows) - s.pos.y -= (s.rows-1); - } - } -} - -# clear row `r' from `first' to `last' column inclusive -rowclear(r, first, last: int) -{ - # 16r5f is the semi-graphic black rectangle - disp->Put(dup(16r5f, last-first+1), Point(first,r), semigraphic, fgBlack, 0); -# disp->Put(dup(' ', last-first+1), Point(first,r), S.cset, fgBlack, 0); -} - -clear(s: ref Screen) -{ - for(r:=1; rRefresh(); -} - -# scroll the screen -scroll(topline, nlines: int) -{ - disp->Scroll(topline, nlines); - disp->Refresh(); -} - -# filter the specified ISO6429 and ISO2022 codes from the screen input -# TODO: filter some ISO2022 sequences -filter(s: ref Screen, data: array of byte): array of array of byte -{ - case T.mode { - Videotex => - return vfilter(s, data); - Mixed => - return mfilter(s, data); - Ascii => - return afilter(s, data); - } - return nil; -} - -# filter the specified ISO6429 and ISO2022 codes from the screen input -vfilter(s: ref Screen, data: array of byte): array of array of byte -{ - ba := array [0] of array of byte; - changed := 0; - - d0 := 0; - for(i:=0; i - if(ch == ESC) { - s.fstate = FSesc; - changed = 1; - if(i > d0) - ba = dappend(ba, data[d0:i]); - d0 = i+1; - } - FSesc => - d0 = i+1; - changed = 1; - if(ch == '[') { - s.fstate = FS6429; - s.fsaved = array [0] of byte; - s.badp = 0; -# } else if(ch == 16r20) { -# s.fstate = FS2022; -# s.fsaved = array [0] of byte; - s.badp = 0; - } else if(ch == ESC) { - ba = dappend(ba, array [] of { byte ESC }); - s.fstate = FSesc; - } else { - # false alarm - don't filter - ba = dappend(ba, array [] of { byte ESC, byte ch }); - s.fstate = FSstart; - } - FS6429 => # filter out invalid CSI sequences - d0 = i+1; - changed = 1; - if(ch >= 16r20 && ch <= 16r3f) { - if((ch < 16r30 || ch > 16r39) && ch != ';') - s.badp = 1; - a := array [len s.fsaved + 1] of byte; - a[0:] = s.fsaved[0:]; - a[len a - 1] = byte ch; - s.fsaved = a; - } else { - valid := 1; - case ch { - 'A' => ; - 'B' => ; - 'C' => ; - 'D' => ; - 'H' => ; - 'J' => ; - 'K' => ; - 'P' => ; - '@' => ; - 'h' => ; - 'l' => ; - 'M' => ; - 'L' => ; - * => - valid = 0; - } - if(s.badp) - valid = 0; - if(debug['f']) - fprint(stderr, "vfilter %d: %s%c\n", valid, string s.fsaved, ch); - if(valid) { # false alarm - don't filter - ba = dappend(ba, array [] of { byte ESC, byte '[' }); - ba = dappend(ba, s.fsaved); - ba = dappend(ba, array [] of { byte ch } ); - } - s.fstate = FSstart; - } - FS2022 => ; - } - } - if(changed) { - if(i > d0) - ba = dappend(ba, data[d0:i]); - return ba; - } - return array [] of { data }; -} - -# filter the specified ISO6429 and ISO2022 codes from the screen input - Videotex -mfilter(s: ref Screen, data: array of byte): array of array of byte -{ - ba := array [0] of array of byte; - changed := 0; - - d0 := 0; - for(i:=0; i - case ch { - ESC => - s.fstate = FSesc; - changed = 1; - if(i > d0) - ba = dappend(ba, data[d0:i]); - d0 = i+1; - SEP => - s.fstate = FSsep; - changed = 1; - if(i > d0) - ba = dappend(ba, data[d0:i]); - d0 = i+1; - } - FSesc => - d0 = i+1; - changed = 1; - if(ch == '[') { - s.fstate = FS6429; - s.fsaved = array [0] of byte; - s.badp = 0; - } else if(ch == ESC) { - ba = dappend(ba, array [] of { byte ESC }); - s.fstate = FSesc; - } else { - # false alarm - don't filter - ba = dappend(ba, array [] of { byte ESC, byte ch }); - s.fstate = FSstart; - } - FSsep => - d0 = i+1; - changed = 1; - if(ch == ESC) { - ba = dappend(ba, array [] of { byte SEP }); - s.fstate = FSesc; - } else if(ch == SEP) { - ba = dappend(ba, array [] of { byte SEP }); - s.fstate = FSsep; - } else { - if(ch >= 16r00 && ch <= 16r1f) - ba = dappend(ba, array [] of { byte SEP , byte ch }); - # consume the character - s.fstate = FSstart; - } - FS6429 => # filter out invalid CSI sequences - d0 = i+1; - changed = 1; - if(ch >= 16r20 && ch <= 16r3f) { - if((ch < 16r30 || ch > 16r39) && ch != ';' && ch != '?') - s.badp = 1; - a := array [len s.fsaved + 1] of byte; - a[0:] = s.fsaved[0:]; - a[len a - 1] = byte ch; - s.fsaved = a; - } else { - valid := 1; - case ch { - 'm' => ; - 'A' => ; - 'B' => ; - 'C' => ; - 'D' => ; - 'H' => ; - 'J' => ; - 'K' => ; - '@' => ; - 'h' => ; - 'l' => ; - 'L' => ; - 'M' => ; - 'P' => ; - '{' => # allow CSI ? { - n := len s.fsaved; - if(n == 0 || s.fsaved[n-1] != byte '?') - s.badp = 1; - * => - valid = 0; - } - if(s.badp) # only decimal params - valid = 0; - if(debug['f']) - fprint(stderr, "mfilter %d: %s%c\n", valid, string s.fsaved, ch); - if(valid) { # false alarm - don't filter - ba = dappend(ba, array [] of { byte ESC, byte '[' }); - ba = dappend(ba, s.fsaved); - ba = dappend(ba, array [] of { byte ch } ); - } - s.fstate = FSstart; - } - FS2022 => ; - } - } - if(changed) { - if(i > d0) - ba = dappend(ba, data[d0:i]); - return ba; - } - return array [] of { data }; -} - -# filter the specified ISO6429 and ISO2022 codes from the screen input - Videotex -afilter(nil: ref Screen, data: array of byte): array of array of byte -{ - return array [] of { data }; -} - -# append to an array of array of byte -dappend(ba: array of array of byte, b: array of byte): array of array of byte -{ - l := len ba; - na := array [l+1] of array of byte; - na[0:] = ba[0:]; - na[l] = b; - return na; -} - -# Put a diagnostic string to row 0 -Screen.msg(s: self ref Screen, str: string) -{ - blank := string array [s.cols -4] of {* => byte ' '}; - n := len str; - if(n > s.cols - 4) - n = s.cols - 4; - disp->Put(blank, Point(1, 0), videotex, 0, 0); - if(str != nil) - disp->Put(str[0:n], Point(1, 0), videotex, fgWhite|attrB, 0); - disp->Refresh(); -} \ No newline at end of file diff --git a/appl/wm/minitel/socket.b b/appl/wm/minitel/socket.b deleted file mode 100644 index b3ce7fcf..00000000 --- a/appl/wm/minitel/socket.b +++ /dev/null @@ -1,49 +0,0 @@ -# -# Copyright © 1998 Vita Nuova Limited. All rights reserved. -# - -Socket: adt { - m: ref Module; # common attributes - in: chan of ref Event; - - init: fn(c: self ref Socket); - reset: fn(c: self ref Socket); - run: fn(c: self ref Socket); - quit: fn(c: self ref Socket); -}; - -Socket.init(c: self ref Socket) -{ - c.in = chan of ref Event; - c.reset(); -} - -Socket.reset(c: self ref Socket) -{ - c.m = ref Module(Pscreen, 0); -} - -Socket.run(c: self ref Socket) -{ -Runloop: - for(;;){ - ev := <- c.in; - pick e := ev { - Equit => - break Runloop; - Eproto => - case e.cmd { - Creset => - c.reset(); - * => break; - } - Edata => - } - } - send(nil); -} - -Socket.quit(c: self ref Socket) -{ - if(c==nil); -} diff --git a/appl/wm/minitel/swkeyb.b b/appl/wm/minitel/swkeyb.b deleted file mode 100644 index 50cb238f..00000000 --- a/appl/wm/minitel/swkeyb.b +++ /dev/null @@ -1,370 +0,0 @@ -### -### This data and information is not to be used as the basis of manufacture, -### or be reproduced or copied, or be distributed to another party, in whole -### or in part, without the prior written consent of Lucent Technologies. -### -### (C) Copyright 1997 Lucent Technologies -### -### Written by N. W. Knauft -### -# -# Revisions Copyright © 1998 Vita Nuova Limited. - -implement Keyboard; - -include "sys.m"; - sys: Sys; - -include "draw.m"; - draw: Draw; - -include "tk.m"; - tk: Tk; - -include "tkclient.m"; - tkclient: Tkclient; - -include "swkeyb.m"; - -#Icon path -ICPATH: con "keybd/"; - -#Font -FONT: con "/fonts/lucidasans/latin1.7.font"; -SPECFONT: con "/fonts/lucidasans/latin1.6.font"; - -# Dimension constants -KBDWIDTH: con 360; -KBDHEIGHT: con 120; -KEYSIZE: con "19"; -KEYSPACE: con 5; -KEYBORDER: con 1; -KEYGAP: con KEYSPACE - (2 * KEYBORDER); -ENDGAP: con 2 - KEYBORDER; - -# Row size constants (cumulative) -ROW1: con 14; -ROW2: con 28; -ROW3: con 41; -ROW4: con 53; -NKEYS: con 63; - -#Special key number constants -DELKEY: con 13; -TABKEY: con 14; -BACKSLASHKEY: con 27; -CAPSLOCKKEY: con 28 ; -RETURNKEY: con 40; -LSHIFTKEY: con 41; -RSHIFTKEY: con 52; -ESCKEY: con 53; -CTRLKEY: con 54; -METAKEY: con 55; -ALTKEY: con 56; -SPACEKEY: con 57; -ENTERKEY: con 58; -LEFTKEY: con 59; -RIGHTKEY: con 60; -DOWNKEY: con 61; -UPKEY: con 62; - -#Special key code constants -CAPSLOCK: con -1 ; -SHIFT: con -2; -CTRL: con -3; -ALT: con -4; -META: con -5; -MAGIC_PREFIX: con 256; -ARROW_OFFSET: con 57344; -ARROW_PREFIX: con ARROW_OFFSET + 18; - -#Special key width constants -DELSIZE: con 44; -TABSIZE: con 32; -BACKSLASHSIZE: con 31; -CAPSLOCKSIZE: con 44; -RETURNSIZE: con 43; -LSHIFTSIZE: con 56; -RSHIFTSIZE: con 55; -ESCSIZE: con 21; -CTRLSIZE: con 23; -METASIZE: con 38; -ALTSIZE: con 22; -SPACESIZE: con 100; -ENTERSIZE: con 31; - -#Arrow key code constants -UP: con ARROW_PREFIX; -DOWN: con ARROW_PREFIX + 1; -LEFT: con ARROW_PREFIX + 2; -RIGHT: con ARROW_PREFIX + 3; - -direction:= array[] of {"up", "down", "left", "right"}; -row_dimensions:= array[] of {0, ROW1, ROW2, ROW3, ROW4, NKEYS}; - -special_keys:= array[] of { - (DELKEY, DELSIZE), - (TABKEY, TABSIZE), - (BACKSLASHKEY, BACKSLASHSIZE), - (CAPSLOCKKEY, CAPSLOCKSIZE), - (RETURNKEY, RETURNSIZE), - (LSHIFTKEY, LSHIFTSIZE), - (RSHIFTKEY, RSHIFTSIZE), - (ESCKEY, ESCSIZE), - (CTRLKEY, CTRLSIZE), - (METAKEY, METASIZE), - (ALTKEY, ALTSIZE), - (SPACEKEY, SPACESIZE), - (ENTERKEY, ENTERSIZE), -}; - -keys:= array[] of { - # Unshifted - "`", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "-", "=", "Delete", - "Tab", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "\\\\", - "CapLoc", "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "\'", "Return", - "Shift", "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "Shift", - "Esc", "Ctrl", " ", "Alt", " ", "Enter", "<-", "->", "v", "^", - # Shifted - "~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "Delete", - "Tab", "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "\\{", "\\}", "|", - "CapLoc", "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", "\"", "Return", - "Shift", "Z", "X", "C", "V", "B", "N", "M", "<", ">", "?", "Shift", - "Esc", "Ctrl", " ", "Alt", " ", "Enter", "<-", "->", "v", "^", -}; - -keyvals:= array[] of { - # Unshifted - '`', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '-', '=', '\b', - '\t', 'q', 'w', 'e', 'r', 't', 'y', 'u', 'i', 'o', 'p', '[', ']', '\\', - CAPSLOCK, 'a', 's', 'd', 'f', 'g', 'h', 'j', 'k', 'l', ';', '\'', '\n', - SHIFT, 'z', 'x', 'c', 'v', 'b', 'n', 'm', ',', '.', '/', SHIFT, - 27, CTRL, META, ALT, 32, '\n', LEFT, RIGHT, DOWN, UP, - # Shifted - '~', '!', '@', '#', '$', '%', '^', '&', '*', '(', ')', '_', '+', '\b', - '\t', 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', 'O', 'P', '{', '}', '|', - CAPSLOCK, 'A', 'S', 'D', 'F', 'G', 'H', 'J', 'K', 'L', ':', '"', '\n', - SHIFT, 'Z', 'X', 'C', 'V', 'B', 'N', 'M', '<', '>', '?', SHIFT, - 27, CTRL, META, ALT, 32, '\n', LEFT, RIGHT, DOWN, UP, -}; - -rowlayout := array[] of { - "frame .f1", - "frame .f2", - "frame .f3", - "frame .f4", - "frame .f5", - "frame .dummy0 -height " + string (ENDGAP), - "frame .dummy1 -height " + string KEYGAP, - "frame .dummy2 -height " + string KEYGAP, - "frame .dummy3 -height " + string KEYGAP, - "frame .dummy4 -height " + string KEYGAP, - "frame .dummy5 -height " + string (ENDGAP + 1), -}; - -# Move key flags -move_key_enabled := 0; -meta_active := 0; - -# Create keyboard widget, spawn keystroke handler -initialize(t: ref Tk->Toplevel, ctxt : ref Draw->Context, dot: string): chan of string -{ - return chaninit(t, ctxt, dot, chan of string); -} - -chaninit(t: ref Tk->Toplevel, ctxt : ref Draw->Context, dot: string, rc: chan of string): chan of string -{ - sys = load Sys Sys->PATH; - draw = load Draw Draw->PATH; - tk = load Tk Tk->PATH; - tkclient = load Tkclient Tkclient->PATH; - - tkclient->init(); - - tk->cmd(t, "frame " + dot + " -bd 2 -relief raised -width " + string KBDWIDTH - + " -height " + string KBDHEIGHT); - tkcmds(t, rowlayout); - - for(i := 0; i < NKEYS; i++) { - tk->cmd(t, "button .b" + string i + " -font " + FONT + " -width " + KEYSIZE - + " -height " + KEYSIZE + " -bd " + string KEYBORDER); - - tk->cmd(t, ".b" + string i + " configure -text {" + keys[i] + - "} -command 'send keypress " + string keyvals[i]); - } - - for(i = 0; i < len special_keys; i++) { - (keynum, keysize) := special_keys[i]; - tk->cmd(t, ".b" + string keynum + " configure -font " + SPECFONT + " -width " + string keysize); - } - - tk->cmd(t, "image create bitmap Capslock_on -file " + ICPATH + "capson.bit -maskfile " + ICPATH + "capson.bit"); - tk->cmd(t, "image create bitmap Capslock_off -file " + ICPATH + "capsoff.bit -maskfile " + ICPATH + "capsoff.bit"); - tk->cmd(t, "image create bitmap Left_arrow -file " + ICPATH + "larrow.bit -maskfile " + ICPATH + "larrow.bit"); - tk->cmd(t, "image create bitmap Right_arrow -file " + ICPATH + "rarrow.bit -maskfile " + ICPATH + "rarrow.bit"); - tk->cmd(t, "image create bitmap Down_arrow -file " + ICPATH + "darrow.bit -maskfile " + ICPATH + "darrow.bit"); - tk->cmd(t, "image create bitmap Up_arrow -file " + ICPATH + "uarrow.bit -maskfile " + ICPATH + "uarrow.bit"); - tk->cmd(t, "image create bitmap Move_on -file " + ICPATH + "moveon.bit -maskfile " + ICPATH + "moveon.bit"); - tk->cmd(t, "image create bitmap Move_off -file " + ICPATH + "moveoff.bit -maskfile " + ICPATH + "moveoff.bit"); - tk->cmd(t, "image create bitmap None -file " + ICPATH + "none.bit -maskfile " + ICPATH + "none.bit"); - tk->cmd(t, ".b" + string CAPSLOCKKEY + " configure -image Capslock_off"); - tk->cmd(t, ".b" + string LEFTKEY + " configure -image Left_arrow"); - tk->cmd(t, ".b" + string RIGHTKEY + " configure -image Right_arrow"); - tk->cmd(t, ".b" + string DOWNKEY + " configure -image Down_arrow"); - tk->cmd(t, ".b" + string UPKEY + " configure -image Up_arrow"); - - for(j:=1; j < len row_dimensions; j++) { - rowstart := row_dimensions[j-1]; - rowend := row_dimensions[j]; - for(i=rowstart; icmd(t, "frame .f" + string j + ".dummy -width " + string ENDGAP); - tk->cmd(t, "pack .f" + string j + ".dummy -side left"); - } - tk->cmd(t, "pack .b" + string i + " -in .f" + string j + " -side left"); - if (i == rowend-1) - tk->cmd(t, "frame .f" + string j + ".dummy" + string i + " -width " + string ENDGAP); - else - tk->cmd(t, "frame .f" + string j + ".dummy" + string i + " -width " + string KEYGAP); - tk->cmd(t, "pack .f" + string j + ".dummy" + string i + " -side left"); - } - } - - tk->cmd(t, "pack .dummy0 .f1 .dummy1 .f2 .dummy2 .f3 .dummy3 .f4 .dummy4 .f5 .dummy5 -in " + dot); - tk->cmd(t,"update"); - - key := chan of string; - spawn handle_keyclicks(t, ctxt, key, rc); - return key; -} - -tkcmds(t: ref Tk->Toplevel, cmds: array of string) -{ - for(i := 0; i < len cmds; i++) - tk->cmd(t, cmds[i]); -} - -# Process key clicks and hand keycodes off to Tk -handle_keyclicks(t: ref Tk->Toplevel, ctxt : ref Draw->Context, sc, rc: chan of string) -{ - keypress := chan of string; - tk->namechan(t, keypress, "keypress"); - - minitel := 0; - caps_locked := 0; - shifted := 0; - ctrl_active := 0; - alt_active := 0; - -Work: - for(;;){ - alt { - k := <-keypress => - (n, cmdstr) := sys->tokenize(k, " \t\n"); - keycode := int hd cmdstr; - case keycode { - CAPSLOCK => - redisplay_keyboard(t, minitel, caps_locked ^= 1, caps_locked); - shifted = 0; - ctrl_active = 0; - alt_active = 0; - SHIFT => - redisplay_keyboard(t, minitel, (shifted ^= 1) ^ caps_locked, caps_locked); - CTRL => - ctrl_active ^= 1; - if (shifted) { - redisplay_keyboard(t, minitel, caps_locked, caps_locked); - shifted = 0; - } - alt_active = 0; - ALT => - alt_active ^= 1; - if (shifted) { - redisplay_keyboard(t, minitel, caps_locked, caps_locked); - shifted = 0; - } - ctrl_active = 0; - META => - if (move_key_enabled) { - if (meta_active ^= 1) - tk->cmd(t, ".b" + string METAKEY + " configure -image Move_on"); - else - tk->cmd(t, ".b" + string METAKEY + " configure -image Move_off"); - } - redisplay_keyboard(t, minitel, caps_locked, caps_locked); - shifted = 0; - ctrl_active = 0; - alt_active = 0; - * => - if (ctrl_active) { - keycode &= 16r1F; - ctrl_active = 0; - } else if (alt_active) { - keycode += MAGIC_PREFIX; - alt_active = 0; - } - if (meta_active && UP <= keycode && keycode <= RIGHT) { - spawn send_move_msg(direction[keycode - ARROW_PREFIX], sc); - } else - tk->keyboard(t, keycode); - if (shifted) { - redisplay_keyboard(t, minitel, caps_locked, caps_locked); - shifted = 0; - } - } - s := <-rc => - case s { - "kill" => - break Work; - "minitel" => - if (!minitel) { - minitel = 1; - redisplay_keyboard(t, minitel, shifted, caps_locked); - } - "standard" => - if (minitel) { - minitel = 0; - redisplay_keyboard(t, minitel, shifted, caps_locked); - } - } - } - } -} - -send_move_msg(dir: string, ch: chan of string) -{ - ch <-= dir; -} - - -# Redisplay keyboard to reflect current state (shifted or unshifted) -redisplay_keyboard(t: ref Tk->Toplevel, minitel, shifted, caps_locked: int) -{ - base: int; - - if (shifted) - base = NKEYS; - else - base = 0; - - for(i:=0; i= int 'A' && val <= int 'Z') { - key = keys[n-NKEYS]; - } else if (val >= int 'a' && val <= int 'z') { - key = keys[n+NKEYS]; - } - } - - tk->cmd(t, ".b" + string i + " configure -text {" + key - + "} -command 'send keypress " + string val); - } - if (caps_locked) - tk->cmd(t, ".b" + string CAPSLOCKKEY + " configure -image Capslock_on"); - else - tk->cmd(t, ".b" + string CAPSLOCKKEY + " configure -image Capslock_off"); - tk->cmd(t, "update"); -} diff --git a/appl/wm/minitel/swkeyb.m b/appl/wm/minitel/swkeyb.m deleted file mode 100644 index 52206801..00000000 --- a/appl/wm/minitel/swkeyb.m +++ /dev/null @@ -1,21 +0,0 @@ -### -### This data and information is not to be used as the basis of manufacture, -### or be reproduced or copied, or be distributed to another party, in whole -### or in part, without the prior written consent of Lucent Technologies. -### -### (C) Copyright 1997 Lucent Technologies -### -### Written by N. W. Knauft -### - -# Revisions Copyright © 1998 Vita Nuova Limited. - -Keyboard: module -{ - PATH: con "/dis/wm/minitel/swkeyb.dis"; - - initialize: fn(t: ref Tk->Toplevel, ctxt : ref Draw->Context, - dot: string): chan of string; - chaninit: fn(t: ref Tk->Toplevel, ctxt : ref Draw->Context, - dot: string, rc: chan of string): chan of string; -}; -- cgit v1.2.3