(* OPREFS OberonOpts -mdai OLinkOpts -mdais *)
(* ------------------------------------------------------------------------
  :Program.     CxLib
  :Author       Franz Schwarz
  :Address.     Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
  :Address.     uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
  :Copyright.   Freeware (freely distributable, copyrighted software)
  :Language.    Oberon-2
  :Translator.  Amiga-Oberon 3.00
  :Contents.    Oberon-Implementation of Commodore's cx.lib
  :Contents.    All functions of Commodore's cx.lib are implemented.
  :Support.     BlackMagic
  :History.     22-Jul-93 Version 1.0 fSchwarz
  :Remark.      As of Amiga Oberon Release 3.00: possible odd pointers to
  :Remark.      array of char/byte: _don't_ compile with OddChk
  ------------------------------------------------------------------------- *)

MODULE CxLib;

(****** CxLib/--overview-- **************************************************
*
*           CxLib is an Oberon implementation of Commodore's
*       commoditiy.library related functions in amiga.lib .    
*       Moreover, it offers several gimmicks that make it superior
*       to Commodore's amiga.lib - functions. There is an additional
*       function ArgBool() that ease handling of boolean-type
*       ToolTypes, as well as an InvertStringForwd() function returning
*       the InputEvents in forward order. The InvertString() function
*       has some additional functinality, like the special magic RETURN
*       mapping (see InvertString() documentation) and the '\xff' Hex
*       esc code. This module closes a possibly open ArgArray ressource
*       handle on shutdown, and correctly gains access to the program's
*       arguments with ArgArrayInit() when calling the ToolType functions
*       with NIL ToolType array handles, but may be flexibly used with
*       different ToolType arrays by supplying valid ToolType array handles,
*       too.
*       
******************************************************************************)

(****** CxLib/--legal-- **************************************************
*
*   LEGAL STATUS
*       CxLib is Freeware, Copyright © 1993 by F.Schwarz. All Rights
*       reserved. Freeware is an abbreviation for Freely Distributable
*       Copyrighted Software. That means, you may freely distribute this
*       software for non-profit-making purposes, and use it in your own
*       freely distributable software. However if you intend to use it
*       in commercial software or shareware you may only use it under the
*       condition you consider me to be a registred, legitimate user of
*       that software and you contact me before releasing that software.
*
*   DISCLAIMER
*       Liability - what liability?? In fact, no liability whatsoever is
*       provided by the author of this software - this is generally known
*       as "USE AT YOUR OWN RISK" - and that is exactly what it means.
*
*   DISTRIBUTION
*       This software may be distributed if only a _reasonable_ copying
*       fee is charged apart from the consts for the media it is copied to.
*       Furthermore, it may be included in Freely Distributable software
*       libraries like AMOK, etc, including CD-ROM versions of them.
*
*   Contact addresses for bug reports, comments, inquiries or anything else:
*
*          Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
*     email: uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
*
*****************************************************************************)


IMPORT 
  e: Exec, d: Dos, km: KeyMap, kml: KeyMapLib, co: Commodities,
  wb: Workbench, ic: Icon, o: OberonLib, b: BlackMagic, ie: InputEvent,
  st: Strings, a: ASCII, y: SYSTEM;


VAR 
  dObject  : wb.DiskObjectPtr;
  rda      : d.RDArgsPtr;  
  ttypes - : b.TTPtr;


(****** CxLib/ArgArrayInit **************************************************
*
*   NAME
*       ArgArrayInit - get a pointer to the program's argument array
*
*   SYNOPSIS
*       ArgArrayInit(): BlackMagic.TTPtr
*
*   FUNCTION
*       Returns a pointer to the argument array no matter whether the
*       program was started from CLI or Workbench. It is safe to call
*       this function multiple times.
*
*   RESULT
*       The pointer to the NIL-terminated array of (untraced) pointers
*       to the argument strings or NIL for failure.
*
*   NOTES
*       Due to Commodore's Dos/ReadArgs() implementation, all CLI args
*       containing a '=' have to be surrounded with quotes. (i.e.
*       "CX_PRIORITY=-1" instead of just CX_PRIORITY=-1)
*       
*   SEE ALSO
*       ArgsArrayDone()
*
******************************************************************************)

PROCEDURE ArgArrayInit* (): b.TTPtr;
VAR
  dir : d.FileLockPtr;
BEGIN
  IF (rda # NIL) OR (dObject # NIL) THEN
    RETURN ttypes;
  END;
  IF o.wbStarted THEN
    dir := d.CurrentDir (o.wbenchMsg(wb.WBStartup).argList[0].lock);
    dObject := ic.GetDiskObjectNew (o.wbenchMsg(wb.WBStartup).argList[0].name^);
    IF dObject # NIL THEN ttypes := dObject.toolTypes; END;
    dir := d.CurrentDir (dir);
  ELSE (* Shell *)
    IF rda = NIL THEN
      rda := d.ReadArgs ("/M", ttypes, NIL);
    END;  
  END;
  RETURN ttypes;
END ArgArrayInit;
      
(****** CxLib/ArgArrayDone **************************************************
*
*   NAME
*       ArgArrayDone - free the resources allocated with ArgArrayInit()
*
*   SYNOPSIS
*       ArgArrayDone ()
*
*   FUNCTION
*       ArgArrayDone frees any possible ressources that have been allocated
*       by previous calls to ArgArrayInit().
*
*   NOTES
*       There is no need to call this function explicitely since it is
*       called during CxLib's shutdown code.
*
*   SEE ALSO
*       ArgArrayInit()
*
****************************************************************************)

PROCEDURE ArgArrayDone *();
BEGIN
  IF dObject#NIL THEN
    ic.FreeDiskObject(dObject);  dObject:=NIL;
  ELSIF rda # NIL THEN
    d.FreeArgs(rda);  rda := NIL;
  END;
  ttypes:=NIL;
END ArgArrayDone;

(****** CxLib/ArgInt ********************************************************
*
*   NAME
*       ArgInt - get number stored in a specific arg or default number
*
*   SYNOPSIS
*       ArgInt (tt        : BlackMagic.TTPtr; 
*               typeName  : ARRAY OF CHAR;
*               defaultVal: LONGINT          ): LONGINT;
*
*   FUNCTION
*       Searches the argument array tt for a typeName-named argument,
*       and returns a valid integer stored in the argument's array.
*       Otherwise, defaultVal is returned.
*
*   INPUTS
*       tt        - a valid pointer to an argument array or NIL, in
*                   which case the argument array returned by 
*                   ArgArrayInit() is used.
*       typeName  - the argument name
*       defaultVal- the default value returned in case of 'failure'
*
*   RESULT
*       If the argument was found, and it contained a valid dec/hex number
*       char sequence, the appertaining integer representation, otherwise
*       defaultVal.
*
*   SEE ALSO
*       ArgString(), ArgBool(), BlackMagic/StrToLong()
*
****************************************************************************)

PROCEDURE ArgInt* (tt: b.TTPtr; typeName: ARRAY OF CHAR;
                   defaultVal: LONGINT): LONGINT;
VAR str: e.STRPTR;
  v: LONGINT;
(* $CopyArrays- *)
BEGIN
  IF tt=NIL THEN tt:=ArgArrayInit(); END;
  IF tt#NIL THEN
    str:=ic.FindToolType(tt, typeName);
    IF str#NIL THEN
      IF b.StrToLong (str^, v) THEN
        RETURN v
      END;
    END;
  END;
  RETURN defaultVal;
END ArgInt;

(****** CxLib/ArgString *******************************************************
*
*   NAME
*       ArgString - get string stored in a specific arg or default string
*
*   SYNOPSIS
*       ArgString (tt        : BlackMagic.TTPtr; 
*                  typeName  : ARRAY OF CHAR;
*                  defaultStr: ARRAY OF CHAR    ): BlackMagic.LongStrPtr
*
*   FUNCTION
*       Searches the argument array tt for a typeName-named argument,
*       and returns its string. If the argument does not exist,
*       defaultVal is returned.
*
*   INPUTS
*       tt        - a valid pointer to an argument array or NIL, in
*                   which case the argument array returned by 
*                   ArgArrayInit() is used.
*       typeName  - the argument name
*       defaultStr- the default string returned in case of 'failure'
*
*   RESULT
*       If the argument was found, the appertaining arg string, 
*       otherwise defaultStr;
*
*   SEE ALSO
*       ArgInt(), ArgBool()
*
****************************************************************************)

PROCEDURE ArgString *(tt: b.TTPtr; typeName: ARRAY OF CHAR;
                      defaultStr: ARRAY OF CHAR): b.LStrPtr;
VAR str: e.APTR;
(* $CopyArrays- *)
BEGIN
  IF tt=NIL THEN tt:=ArgArrayInit(); END;
  IF tt#NIL THEN
    str:=ic.FindToolType(tt, typeName);
    IF str#NIL THEN RETURN str; END;
  END;
  RETURN b.StrIndex (defaultStr, 0);
END ArgString;

(****** CxLib/ArgBool *********************************************************
*
*   NAME
*       ArgBool - get boolean value stored in specific arg or default bool
*
*   SYNOPSIS
*       ArgBool (tt         : BlackMagic.TTPtr; 
*                typeName   : ARRAY OF CHAR;
*                defaultBool: BOOLEAN          ): BOOLEAN
*
*   FUNCTION
*       Searches the argument array tt for a typeName-named argument,
*       and returns TRUE if the argument's value string is empty, or
*       if it includes 'TRUE' / 'YES'  (case-insensitive). It returns
*       FALSE if the typeName-named argument was found and its value
*       string is not empty and doesn't contain 'TRUE' or 'YES'. If
*       the searched argument is not found, defaultBool is returned.
*
*   INPUTS
*       tt        - a valid pointer to an argument array or NIL, in
*                   which case the argument array returned by 
*                   ArgArrayInit() is used.
*       typeName  - the argument name
*       defaultStr- the default boolean value.
*
*   RESULT
*       If the argument was found, the appertaining boolean value,
*       otherwise defaultBool;
*
*   SEE ALSO
*       ArgInt(), ArgString()
*
****************************************************************************)

PROCEDURE ArgBool* (tt: b.TTPtr; typeName: ARRAY OF CHAR;
                    defaultBool: BOOLEAN): BOOLEAN;
VAR str: e.STRPTR;
(* $CopyArrays- *)
BEGIN
  IF tt=NIL THEN tt:=ArgArrayInit(); END;
  IF tt#NIL THEN
    str:=ic.FindToolType(tt, typeName);
    IF str#NIL THEN 
      IF str[0]='\000' THEN
        RETURN TRUE;
      ELSIF ic.MatchToolValue(str^,"YES") OR ic.MatchToolValue(str^,"TRUE") THEN
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END;
  END;
  RETURN defaultBool;
END ArgBool;


(****** CxLib/HotKey ********************************************************
*
*   NAME
*       HotKey - create a triad of commodities objects for a hotkey
*
*   SYNOPSIS
*       HotKey (descr: ARRAY OF CHAR;
*               port : Exec.MsgPortPtr;
*               id   : LONGINT         ): Commodities.CxObjPtr
*
*   FUNCTION
*       This function creates a Filter-, a Sender-, and a Translate-
*       CxObject and connects them so that any input event matching
*       <descr> will dispatch a message to <port> with identifier
*       code <id> and the input event will be removed from the input
*       stream.
*
*   INPUTS
*       descr    - the input description string for the hotkey
*       port     - the Exec.MsgPort that shall receive a msg 
*                  whenever the hotkey is pressed
*       id       - the id code to be sent to the port with the msg.
*
*   RESULT
*       a valid Commodities.CxObjPtr, or NIL in case of failure.
*
*   SEE ALSO
*       Commodities.doc
*
****************************************************************************)

PROCEDURE HotKey* (descr: ARRAY OF CHAR; port: e.MsgPortPtr;
                   id: LONGINT): co.CxObjPtr;
VAR cx1: co.CxObjPtr;
(* $CopyArrays- *)
BEGIN
  cx1:=co.CxFilter (b.StrIndex (descr, 0));
  IF cx1#NIL THEN
    co.AttachCxObj (cx1, co.CxSender (port, id));
    co.AttachCxObj (cx1, co.CxTranslate (NIL));
    IF co.CxObjError (cx1) = LONGSET{} THEN
      RETURN cx1;
    END;
    co.DeleteCxObjAll (cx1);
  END;
  RETURN NIL;
END HotKey;

(****** CxLib/FreeIEvents *******************************************************
*
*   NAME
*       FreeIEvents - frees a chain of input events from InvertString()
*
*   SYNOPSIS
*       FreeIEvents (VAR iEvent: InputEvent.InputEventPtr);
*
*   FUNCTION
*       This functions frees a chain of input events allocated by
*       InvertString() / InvertStringForwd()
*       
*   INPUTS
*       iEvent   - pointer to a chain of InputEvents. MUST have been
*                  returned from InvertString() / InvertStringForwd()
*                  May be NIL.
*
*   RESULT
*       the VAR iEvent is cleared
*
*   SEE ALSO
*       InvertString(), InvertStringForwd()
*
****************************************************************************)

PROCEDURE FreeIEvents* (VAR iEvent: ie.InputEventPtr);
VAR 
  ie1: ie.InputEventPtr;
BEGIN
  WHILE iEvent#NIL DO
    ie1:=iEvent; iEvent:=iEvent.nextEvent;
    e.FreeVec (ie1);
  END;
END FreeIEvents;

CONST  
  returnRawKeyCode = 44H;
  retEvent = ie.InputEvent (NIL, ie.rawkey, 0, returnRawKeyCode, {}, 0, 0, 0, 0);

(****** CxLib/InvertString ******************************************************
*
*   NAME
*       InvertString - create chain of ievents from mixed str / IX descr
*       InvertStringForwd - create chain of ievents in forward order
*
*   SYNOPSIS
*       InvertString (string: ARRAY OF CHAR;
*                     km    : KeyMapPtr     ): InputEvent.InputEventPtr;
*
*       InvertStringForwd (string: ARRAY OF CHAR;
*                          km    : KeyMapPtr   ): InputEvent.InputEventPtr;
*
*   FUNCTION
*       These functions create a chain of InputEvents from a string
*       consisting of normal string sequences with backslash escape
*       sequences ('\\','\r','\n','\f','\e',"\'",'\"','\xff','\<','\t',
*       '\0') and Commodities' input description strings enclosed in
*       angled brackets ('<input desr>'). As a special bonus, this
*       function always converts carriage returns from not within
*       input description sequences ('<inp descr>') into RETURN_RAWKEY
*       events if the return rawkey maps to carriage return. This
*       functionality is not available in Commodore's amiga.lib-
*       InvertString() although this is of significance for inserting
*       text into many editors, as internal remapping of ENTER is quite
*       frequent in that field.
*
*   INPUTS
*       string   - the string to be converted into a chain of InputEvents
*       km       - the keymap to be used for converting. May be NIL in
*                  which case the system's current default keymap is used.
*
*   RESULT
*       a pointer to the first InputEvent of an InputEvent chain or NIL.
*
*   NOTES
*       Like Commodore's InvertString() function, InvertString() returns
*       the InputEvents chained in REVERSE ORDER, ie. the resulting pointer
*       points to the last InputEvent, and the first InputEvent is last
*       in the list. Thus you should preferably use InvertStringForwd(),
*       since that function returns the generated events in forward order,
*       as its name already implies.
*
*   SEE ALSO
*       Commodities/ParseIX()
*
****************************************************************************)

PROCEDURE InvertString* (string: ARRAY OF CHAR; km: km.KeyMapPtr): ie.InputEventPtr;

VAR 
  iEvent1,iEvent2: ie.InputEventPtr;
  fail           : BOOLEAN;
  ch             : CHAR;
  cb             : ARRAY 1 OF CHAR;
  str            : b.LStrPtr;
  remapret       : BOOLEAN;
  
  PROCEDURE DoAngle(): BOOLEAN;
  VAR 
    tempstr: b.DynStrPtr;
    l      : LONGINT;
    ix     : co.IXPtr;
    r      : BOOLEAN;
  (* $CopyArrays- *)
  BEGIN
    tempstr := NIL; ix := NIL;
    l:=0; r:=FALSE;
    WHILE (str[l] # '\000') & (str[l] # '>') DO INC(l); END;
    IF str[l] # '\000' THEN
      IF b.DynExpand (tempstr, l) THEN 
        st.Cut (str^, 0, l, tempstr^);
        ix:=e.AllocVec (SIZE (co.IX), LONGSET{e.memClear,e.public});
        IF ix # NIL THEN
          str := b.StrIndex (str^, l);
          IF co.ParseIX (tempstr^,ix^) # 0 THEN
            y.SETREG (0, d.SetIoErr (d.objectWrongType));
          ELSE  
            iEvent2.class := ix.class;
            iEvent2.code := y.VAL(INTEGER,ix.code);
            iEvent2.qualifier := ix.qualifier;
            r:=TRUE;
          END;
        END;
      END;    
    END;  
    IF ix # NIL THEN e.FreeVec (ix); END;
    IF tempstr # NIL THEN DISPOSE (tempstr); END;
    RETURN r;
  END DoAngle;
  
  PROCEDURE DoEsc (): LONGINT; 
  VAR
    c: CHAR;
    n: LONGINT;
  BEGIN
    CASE CAP (str[1]) OF
    '\"','\'','<','\\': ch := str[1]; RETURN 1; |
    '0': ch := a.nul; RETURN 1; |
    'N','R': ch := a.cr; RETURN 1; |
    'F': ch := a.ff; RETURN 1; |
    'T': ch := a.ht; RETURN 1; |
    'X': 
      c := CAP (str[2]);
      CASE c OF '0'..'9', 'A'..'F': 
        n := ORD (c) - ORD ('0');
        CASE c OF 'A'..'F': n := n + 10 + ORD ('0') - ORD ('A'); ELSE END;
        c := CAP (str[3]);
        CASE c OF '0'..'9', 'A'..'F': 
          n := n * 16 + ORD (c) - ORD ('0');
          CASE c OF 'A'..'F': n := n + 10 + ORD ('0') - ORD ('A'); ELSE END;
          ch := CHR (n); RETURN 3;
        ELSE END;
        ch := CHR (n); RETURN 2;
      ELSE END;
    ELSE END;
    ch := '\\'; RETURN 0;
  END DoEsc;  

(* $CopyArrays- *)
BEGIN
  iEvent1 := NIL; iEvent2 := NIL; remapret := FALSE;
  IF kml.base # NIL THEN IF kml.MapRawKey (y.ADR (retEvent), cb, 1, km) = 1 THEN
    remapret := cb[0] = a.cr (* is carriage return mapped to rawkey code RETURN ? *)
  END; END;
  str := b.StrIndex (string, 0);
  LOOP
    fail := FALSE;
    iEvent1 := NIL;
    IF ORD (str[0]) = 0 THEN RETURN NIL; END;
    REPEAT
      iEvent2 := e.AllocVec (SIZE (ie.InputEvent), LONGSET{e.memClear,e.public});
      IF iEvent2 = NIL THEN fail := TRUE; EXIT; END;
      ch := str[0];
      IF (ch = '<') & (str[1] # a.nul) THEN
        str := b.StrIndex (str^, 1);
        IF ~DoAngle () THEN fail := TRUE; EXIT; END;  
      ELSE  
        CASE ch OF '\\':
          str := b.StrIndex (str^, DoEsc ());
        ELSE END;
        CASE ch OF a.lf: ch := a.cr; ELSE END;
        IF (ch = a.cr) & remapret THEN (* cr magic *)
          iEvent2^ := retEvent;
        ELSE  
          IF co.InvertKeyMap (ORD (ch), iEvent2, km) = 0 THEN 
            y.SETREG (0, d.SetIoErr (d.objectWrongType)); fail := TRUE; EXIT;
          END;  
        END;
      END;
      str := b.StrIndex (str^, 1);
      iEvent2.nextEvent := iEvent1;
      iEvent1 := iEvent2; iEvent2 := NIL;
    UNTIL str[0] = '\000';
    EXIT;
  END;
  IF fail THEN FreeIEvents (iEvent1); FreeIEvents (iEvent2); RETURN NIL; END;
  RETURN iEvent1;
END InvertString;

PROCEDURE InvertStringForwd* (str: ARRAY OF CHAR; km: km.KeyMapPtr):
                              ie.InputEventPtr;
VAR 
  ie1,ie2,ie3,ie4: ie.InputEventPtr;
(* $CopyArrays- *)
BEGIN
  ie1:=InvertString(str, km);
  IF ie1#NIL THEN
    ie4:=ie1; ie3:=ie1.nextEvent;
    WHILE ie3#NIL DO ie2:=ie1; ie1:=ie3; ie3:=ie1.nextEvent; ie1.nextEvent:=ie2; END;
    ie4.nextEvent:=NIL;
  END;
  RETURN ie1;
END InvertStringForwd;

BEGIN

CLOSE
  ArgArrayDone();

END CxLib.