// This is file QL2SET.BCP
//
// To be renamed FLP2_KERSET_BCPL for QDOS
SECTION "Set-options"
/*       Implementation of the Kermit SET command in BCPL

         Written by David Harper

*/
GET "LIBHDR"
GET "FLP2_KERHDR"
//
LET do.set() BE
$(0
  LET fn.set = 0
  IF nwords = 1 DO
  $(1 // The only word on the command line is SET
    writes("No keyword supplied to SET.*N")
    show.set()
    RETURN
  $)1
  TEST do.parse(argv!1,set.com.table) THEN
  $(2 // We have found a command
    TEST nwords=2 THEN
    $(3 // We only have the keyword ... no value
      writef("SET %S : no value specified*N",argv!1)
    $)3
    ELSE
    $(4 // Set the parameter
        /* Programming note : we do this by using an array of functions
           called set.function.table. For example, to set parity, we
           match argv!1 with the entry ws.parity in the command word
           table set.com.table ; then the function we need to use to
           set the parity will be the entry ws.entry in the function
           table set.function.table

           The invocation of the routine is as follows :
        */
           fn.set := set.function.table!command   // Get the function address
           fn.set()                               // Invoke it
        /*
           Check the routine 'initialise' in "MAIN" for the proper names
           of the set functions as they are initialised.
        */
           ser.corrupt := line.changed(command)   // Altered RS232
                                                  // characteristics ?
    $)4
  $)2
  ELSE
  $(5
    writef("Error : unknown option SET %S*N",argv!1)
    erroring := TRUE
  $)5
$)0
AND numeric.value(string) = VALOF
$(0 // Convert a string to a positive numeric value
/* This routine uses the following convention for representation of a
   number :

   Prefix $ indicates a hexadecimal number

   Otherwise (default) it's a decimal number

   Any invalid characters within the string cause the result to be set
   to -1
*/
LET radix,ksum,ch,nch,kch,hex = 10,0,0,0,0,FALSE
nch := getbyte(string,0)
kch := 0
IF getbyte(string,1)='$' THEN
$(1 // We have a hex number
  radix := 16
  hex   := TRUE
  kch   := kch + 1
$)1
$(2 // Process each character
  kch := kch + 1
  IF kch>nch THEN BREAK           // End of the string
  ch := getbyte(string,kch)
  SWITCHON ch INTO
  $(3 // Branch on the character just read
    CASE '0' :  ksum := radix*ksum
                ENDCASE

    CASE '1' :  ksum := radix*ksum + 1
                ENDCASE

    CASE '2' :  ksum := radix*ksum + 2
                ENDCASE

    CASE '3' :  ksum := radix*ksum + 3
                ENDCASE

    CASE '4' :  ksum := radix*ksum + 4
                ENDCASE

    CASE '5' :  ksum := radix*ksum + 5
                ENDCASE

    CASE '6' :  ksum := radix*ksum + 6
                ENDCASE

    CASE '7' :  ksum := radix*ksum + 7
                ENDCASE

    CASE '8' :  ksum := radix*ksum + 8
                ENDCASE

    CASE '9' :  ksum := radix*ksum + 9
                ENDCASE

    CASE 'A' :  TEST hex THEN ksum := radix*ksum + 10
                         ELSE ksum := -1
                         ENDCASE

    CASE 'B' :  TEST hex THEN ksum := radix*ksum + 11
                         ELSE ksum := -1
                         ENDCASE

    CASE 'C' :  TEST hex THEN ksum := radix*ksum + 12
                         ELSE ksum := -1
                         ENDCASE

    CASE 'D' :  TEST hex THEN ksum := radix*ksum + 13
                         ELSE ksum := -1
                         ENDCASE

    CASE 'E' :  TEST hex THEN ksum := radix*ksum + 14
                         ELSE ksum := -1
                         ENDCASE

    CASE 'F' :  TEST hex THEN ksum := radix*ksum + 15
                         ELSE ksum := -1
                         ENDCASE

    DEFAULT  :  ksum := -1
                ENDCASE
  $)3
$)2 REPEATUNTIL  ksum<0
RESULTIS ksum
$)0
//
//
//
AND microparse(aword,entries,word1,word2,word3,word4,word5,word6,word7,
  word8,word9,word10) = VALOF $(0
  LET thisword,kword,found,maxentry = @word1,0,FALSE,0
  maxentry := (entries>10 ->  10,entries)
  $(1
    kword := kword + 1
    found := strcomp(aword,!thisword)
    thisword := thisword + 1
  $)1 REPEATUNTIL found | (kword=maxentry)
  RESULTIS (found -> kword,0)
$)0
//
//
//
AND bad.set.option() BE $(0
  writes("Invalid option encountered :*N")
  writef("SET %S %S*N",argv!1,argv!2)
$)0
/*

   We now give the routines used to set the various options

*/
AND set.debug() BE $(0
  LET option = microparse(argv!2,2,"ON","OFF")
  AND dfd = 0
  SWITCHON option INTO
  $(1
    CASE 1 : // SET DEBUG ON
      debug := TRUE
      IF nwords=4 THEN
      $(F // we have a filename ... try to open it
        dfd := findoutput(argv!3)
        TEST dfd>0 THEN debug.fd := dfd
                   ELSE $( debug.fd := console
                           writes("*NFailed to open debug file ")
                           writes(argv!3)
                           newline()
                        $)
      $)F
      ENDCASE

    CASE 2 : // SET DEBUG OFF
      debug := FALSE
      IF nwords=4 THEN
      $(G // do we want to close the current debug file ?
        IF strcomp(argv!3,"CLOSE") & debug.fd\=console THEN
        $(CD  close(debug.fd)
              debug.fd := console
        $)CD
      $)G
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.delay() BE $(0
  LET option = numeric.value(argv!2)
  TEST option<0 THEN
  $(1  bad.set.option()  $)1
  ELSE
  $(2
    TEST option<60 THEN remote.delay := option
    ELSE $(3  writef("You don't really want to wait %N seconds",option)
              writes(", do you ?*N")
              remote.delay := 60
         $)3
  $)2
$)0
//
AND set.duplex() BE $(0
  LET option = microparse(argv!2,2,"FULL","HALF")
  SWITCHON option INTO
  $(1
    CASE 1 : // SET DUPLEX FULL
      ser.duplex := 'F'
      ENDCASE

    CASE 2 : // SET DUPLEX HALF
      ser.duplex := 'H'
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.8bitprefixing() BE $(0
  LET option = microparse(argv!2,2,"ON","OFF")
  SWITCHON option INTO
  $(1
    CASE 1 : // SET 8BIT-PREFIX ON
      quote8ing := TRUE
      ENDCASE

    CASE 2 : // SET 8BIT-PREFIX OFF
      quote8ing := FALSE
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.eol() BE $(0
  LET option = microparse(argv!2,2,"CR","LF")
  SWITCHON option INTO
  $(1
    CASE 1 : // SET END-OF-LINE CR
      r.eol := cr
      ENDCASE

    CASE 2 : // SET END-OF-LINE LF
      r.eol := lf
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.terminal.escape() BE $(0
  LET option = microparse(argv!2,7,"F1","F2","F3","F4","F5","ESC","CTRL-ESC")
  SWITCHON option INTO
  $(1
    CASE 1 : // SET ESCAPE-CHAR F1
      ser.escape := kbd.f1
      ENDCASE

    CASE 2 : // SET ESCAPE-CHAR F2
      ser.escape := kbd.f2
      ENDCASE

    CASE 3 : // SET ESCAPE-CHAR F3
      ser.escape := kbd.f3
      ENDCASE

    CASE 4 : // SET ESCAPE-CHAR F4
      ser.escape := kbd.f4
      ENDCASE

    CASE 5 : // SET ESCAPE-CHAR F5
      ser.escape := kbd.f5
      ENDCASE

    CASE 6 : // SET ESCAPE-CHAR ESC
      ser.escape := kbd.esc
      ENDCASE

    CASE 7 : // SET ESCAPE-CHAR CTRL-ESC
      ser.escape := kbd.ctrl.esc
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.marker() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>=0 & option<27 THEN  r.sop := option
                             ELSE  bad.set.option()
$)0
//
AND set.packet.length() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>10 & option<93 THEN  r.packet.length := option
                             ELSE  bad.set.option()
$)0
//
AND set.pad.char() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>=0 & option<32 THEN  r.padchar := option
                             ELSE bad.set.option()
$)0
//
AND set.padding() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>=0 THEN r.pad := option
                 ELSE bad.set.option()
$)0
//
AND set.parity() BE $(0
  LET option = microparse(argv!2,5,"EVEN","ODD","MARK","SPACE","NONE")
  SWITCHON option INTO
  $(1
    CASE 1 : // SET PARITY EVEN
      ser.parity := 'E'
      ENDCASE

    CASE 2 : // SET PARITY ODD
      ser.parity := 'O'
      ENDCASE

    CASE 3 : // SET PARITY MARK
      ser.parity := 'M'
      ENDCASE

    CASE 4 : // SET PARITY SPACE
      ser.parity := 'S'
      ENDCASE

    CASE 5 : // SET PARITY NONE
      ser.parity := 'N'
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.pause() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>=0 THEN ser.pause := option
                 ELSE bad.set.option()
$)0
//
AND set.prefix() BE  quote8 := getbyte(argv!2,1)

//
AND set.retry() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>0 THEN maxtry := option
                ELSE bad.set.option()
$)0
//
AND set.timeout() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>0 THEN r.timeout := option
                ELSE bad.set.option()
$)0
//
AND set.line() BE $(0
  LET option = microparse(argv!2,4,"1","SER1","2","SER2")
  SWITCHON option INTO
  $(1
    CASE 1 : // SET LINE 1
    CASE 2 : // SET LINE SER1
      ser.line := '1'
      ENDCASE

    CASE 3 : // SET LINE 2
    CASE 4 : // SET LINE SER2
      ser.line := '2'
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.baud() BE $(0
  LET option = numeric.value(argv!2)
  SWITCHON option INTO
  $(1
    CASE 75: CASE 150: CASE 300: CASE 600: CASE 1200: CASE 2400:
    CASE 3600: CASE 4800: CASE 9600:
      ser.baud := option
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
AND set.interface() BE $(0
  LET option = microparse(argv!2,3,"NONE","RAW","QCONNECT")
  SWITCHON option INTO
  $(1
    CASE 1 : CASE 2 : // SET INTERFACE NONE or RAW  i.e. no little black box
      ser.interface := interface.none
      ENDCASE

    CASE 3 : // SET INTERFACE QCONNECT : Tandata's little black box
      ser.interface := interface.qconnect
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.handshake() BE $(0
  LET option = microparse(argv!2,3,"CTS","XON","NONE")
  SWITCHON option INTO
  $(1
    CASE 1 : // Hardware handshake
      ser.handshake := 'H'
      ENDCASE

    CASE 2 : // Software handshake
      ser.handshake := 'X'
      ENDCASE

    CASE 3 : // No handshake at all
      ser.handshake := 'I'
      ENDCASE

    DEFAULT : // Whoops !!
      bad.set.option()
  $)1
$)0
//
AND line.changed(value) = (value=ws.parity) | (value=ws.line) |
  (value=ws.baud) | (value=ws.handshake) | (value=ws.interface)
//
AND not.yet.implemented() BE $(0
  writes("*N This option has not yet been implemented. *N")
$)0
//
AND set.take.echo() BE $(0
  LET option = microparse(argv!2,2,"ON","OFF")
  SWITCHON option INTO
  $(1
    CASE 1 : // SET TAKE-ECHO ON
      take.echo := TRUE
      ENDCASE

    CASE 2 : // SET TAKE-ECHO OFF
      take.echo := FALSE
      ENDCASE

    DEFAULT : // Unknown option
      bad.set.option()
  $)1
$)0
//
AND set.packetlength() BE $(0
  LET option = numeric.value(argv!2)
  TEST option>30 & option <93 THEN
  $(1
    maxpack := option
  $)1
  ELSE
  $(2
    maxpack := 80
    bad.set.option()
  $)2
$)0