Columbia Kermit/kermit.zip/atarihc/atari.act

Text File | 2020-01-01 | 41KB | 2,491 lines

;<<<KERMIT.PNS>>> -- a sample phones file
SU-Score(300)#4153221570
SU-Score(1200)#4154970061
;<<<D:KCOM1030.ACT>>>
;All the communications stuff:
;
;Opening, closing and dialing for
;the ATARI 1030 modem
;
; KERMIT protocol
; for Atari Home Computers
; version 1.1
; (C) 1983 John Howard Palevich
; to be distributed free of charge
;
;Started NOVEMBER 5, 1983

;Print a string which will identify,
;to the user, what hardware this
;COM file supports

PROC MODEMINIT()
  PRINTE("for the Atari 1030 modem")
  RETURN

;Return number of character in the
;input buffer

CARD FUNC NCIB()
  BYTE INCNT = $400
  RETURN(INCNT)

;Put a character out the modem

PROC PUTR(BYTE DATA)
  PUTD(2, DATA)
  RETURN

;Put out a byte as a modem command

PROC PUTCMD(BYTE CMD)
  BYTE CMCMD = $0007
  CMCMD = $FF
  PUTD(2, 27)
  PUTD(2, CMD)
  CMCMD = 0
  RETURN

;Temporarily Suspend Communications
;so that file I/O can take place

PROC StopR()
  PUTCMD('Z)
  RETURN

;Close down the modem channel

PROC CloseR()
  PUTCMD('Y)
  CLOSE(2)
  RETURN

;Initialize communications

BYTE FUNC OpenR()
  STRING fname = "##:"
  BYTE T
  Close(2)
  fname(1) = 'T
  fname(2) = '1
  t = 12
  Open(2, fname, t, 0)
  T = MSTATUS(2)
  IF T >= 128
  THEN
    PRINTF("Can't open %S, error %B%E",
      fname, T)
    CLOSE(2)
    RETURN(T)
  FI

  RETURN(0)

PROC StartR()
  PUTCMD('Y) ;Resume operation
  PUTCMD('A)
    PUTR($20)
    PUTR('?) ;No Translation
  PUTCMD('C)
    PUTR(PARITY)
  RETURN

;SubEQ(S, I, SS)
;
; Check if SS is = S(I..I+Len(SS)-1)

BYTE FUNC SUBEQ(STRING S BYTE I STRING SS)
  INT J
  IF S(0)-I+1 < SS(0) THEN RETURN(0) FI

  FOR J = 1 TO SS(0) DO
    IF S(I+J-1) <> SS(J) THEN
      RETURN(0)
    FI
  OD

  RETURN(1)


;Dial the number in string P
;return 0 if failure, 1 if OK

BYTE FUNC AutoDial(STRING P)
  BYTE I, NN, C, DVSTAT1 = $2EB

  NN = P(0)     ;LENGTH OF STRING

  ;This modem ignores baud rate

  FOR C = 1 TO NN
  DO
    IF P(C) = '# THEN
      DO
        C ==+ 1
      UNTIL
        C > NN OR P(C) > 32
      OD
      EXIT
    FI
  OD
  IF C > NN  THEN
    PRINTE("No phone number in this entry!")
    RETURN(0)
  FI

  PRINTE("Dialing...press any key to abort")
  ERRORNUM = 0
  STARTR()

  IF dial = 0 THEN
    PUTCMD('N)
  ELSE
    PUTCMD('O)
  FI

  PUTCMD('K)
  FOR I = C TO NN
  DO
    PutR(P(I))
  OD
  PutR($9B)

  ;Wait for carrier
  WHILE CH = $FF DO
    MDEVSTAT(2)
    IF (DVSTAT1 & $80) <> 0 THEN
      RETURN(1)
    FI
  OD
  PRINTE("User abort")
  PUTCMD('M) ;Go on-hook
  STOPR()
  RETURN(0)

;Hang up the phone line

PROC HANGUP()
  STARTR()
  PUTCMD('M) ;Go on-hook
  STOPR()
  RETURN

; --- END OF D:KCOM1030.ACT ---

;<<<D:KCOM850.ACT>>>
;All the communications stuff:
;
; Opening, closing and
; DIALING
; (for the DC-Hayes Smartmodem)
; KERMIT protocol
; for Atari Home Computers
; version 1.1
; (C) 1983 John Howard Palevich
; to be distributed free of charge
;
;Started NOVEMBER 5, 1983

PROC MODEMINIT()
  PRINTE("for the Atari 850 and the")
  PRINTE("DC-Hayes Smartmodem")
  RETURN

CARD FUNC NCIB()
  CARD NC = 747,
       INCNT = $400
  BYTE I
  MDEVSTAT(2)
  I = MSTATUS(2)
  IF I >= 128 THEN
    PRINTF("R: device error: %D%E",
      I)
    RETURN(0)
  FI
  RETURN(NC)

PROC PUTR(BYTE DATA)
  PUTD(2, DATA)
  RETURN

;Temporarily Suspend Communications I/O

PROC StopR()
  Close(2)
  RETURN

PROC CloseR()
  CLOSE(2)
  RETURN

BYTE FUNC OpenR()
  STRING fname = "##:"
  BYTE T
  Close(2)
  fname(1) = 'R
  fname(2) = dnum + '0
  t = 13
  Open(2, fname, t, 0)
  T = MSTATUS(2)
  IF T >= 128
  THEN
    PRINTF("Can't open %S, error %B%E",
      fname, T)
    CLOSE(2)
    RETURN(T)
  FI

  CIOV(2, 34, 0, 0, 192+48, 0)
  CIOV(2, 38, 0, 0, 32+PARITY*5, 0)
  CIOV(2, 36, 0, 0, 8+baud, 0)
  CIOV(2, 40, 0, 0, 0, 0)
  RETURN(0)

PROC StartR()
    OpenR()
    RETURN

;SubEQ(S, I, SS)
;
; Check if SS is = S(I..I+Len(SS)-1)

BYTE FUNC SUBEQ(STRING S BYTE I STRING SS)
  INT J
  IF S(0)-I+1 < SS(0) THEN RETURN(0) FI

  FOR J = 1 TO SS(0) DO
    IF S(I+J-1) <> SS(J) THEN
      RETURN(0)
    FI
  OD

  RETURN(1)

;GetMack() - wait for reply from SM
PROC GetMack()
  BYTE A, S
  IF ERRORNUM >= 128 THEN RETURN
  FI
  S = 0
  DO
    IF CH <> $FF THEN
      ERRORNUM = $FF
      RETURN
    FI
    IF NCIB() > 0 THEN
      A = GETD(2)
      IF DEBUG = 1 THEN
        PUT(27)
        PUT(A)
      FI
      IF S = 0 THEN
        IF A >= 32 THEN
          S = 1
        FI
      ELSE
        IF A = 10 THEN ;End of reply
          RETURN
        FI
      FI
    FI
  OD

;PutMatch(c) - put a character out
; to R:, wait for a matching character
; or user's abort

PROC PutMatch(BYTE c)
  BYTE A
  PUTD(2, C)
  IF ERRORNUM >= 128 THEN RETURN
  FI
  DO
    IF CH <> $FF THEN
      ERRORNUM = $FF
      RETURN
    FI
    IF NCIB() > 0 THEN
      A = GETD(2)
      IF DEBUG = 1 THEN
        PUT(27)
        PUT(A)
      FI
      IF A = C THEN
        RETURN
      FI
    FI
  OD

;Dial the number in string P....

BYTE FUNC AUTODIAL(STRING P)
  BYTE I, C, NN

  NN = P(0)     ;LENGTH OF STRING

  ;See if Baud Rate Specified
  FOR C = 1 TO NN
  DO
    IF P(C) = '( THEN
      IF SUBEQ(P,C,"(300)") = 1 THEN
        BAUD = 0
      ELSEIF SUBEQ(P,C,"(1200)") = 1
      THEN
        BAUD = 2
      FI
      EXIT
    FI
  OD

  FOR C = 1 TO NN
  DO
    IF P(C) = '# THEN
      DO
        C ==+ 1
      UNTIL
        C > NN OR P(C) > 32
      OD
      EXIT
    FI
  OD
  IF C > NN  THEN
    PRINTE("No phone number in this entry!")
    RETURN(0)
  FI

  PRINTE("Dialing...press any key to abort")
  ERRORNUM = 0
  STARTR()
  PutMatch(13) ;Establish baud Rate
  PutMatch('A)
  PutMatch('T)
  PutMatch(13)
  GetMack() ;Swallow Reply
  PutMatch('A)
  PutMatch('T)
  PutMatch(' )
  PutMatch('D)
  IF dial = 0 THEN
    PutMatch('P)
  ELSE
    PutMatch('T)
  FI
  FOR I = C TO P(0)
  DO
    PutMatch(P(I))
  OD
  PutMatch(13)
  DO
    IF ERRORNUM >= 128
      OR CH <> $FF THEN
      PRINTE("User Aborted")
      PUTD(2, 13) ;to get out of wait-for-carrier mode
      I = RTCLOCK+10
      WHILE RTCLOCK <> I DO OD ;Drain
      STOPR()
      RETURN(0)
    FI
    IF NCIB() > 0 THEN
      C = GetD(2)
      IF DEBUG = 1 THEN
        PUT(27)
        PUT(C)
      FI
      IF C = 'C OR C = '1 THEN ;Connected
        STOPR()
        RETURN(1)
      ELSEIF C >= 32 THEN
        PrintF("Unexpected result '%C'%E", C)
        STOPR()
        RETURN(0)
      FI
    FI
  OD

;CAUSE THE SMARTMODEM TO HANG UP

PROC HANGUP()
  BYTE B
  STARTR()
  ;As per page 9-2 of the Smart-
  ;modem manual.  Basicly, the
  ;escape sequence has to be pre-
  ;ceded by at least one character,
  ;and we can't count on the user
  ;having typed one, so we type one
  ;ourselves.

  PUTR('+)
  WAIT(100)
  PUTR('+)
  PUTR('+)
  PUTR('+)
  WAIT(200)
  ;Flush buffer
  WHILE NCIB() > 0 DO
    B = GETD(2)
    IF DEBUG = 1 THEN
      PUT(27)
      PUT(B)
    FI
  OD
  ERRORNUM = 0
  PutMatch(13) ;Establish baud Rate
  PutMatch('A)
  PutMatch('T)
  PutMatch(13)
  GetMack() ;Swallow Reply
  PUTMATCH('A)
  PUTMATCH('T)
  PUTMATCH(32)
  PUTMATCH('H)
  PUTMATCH('0)
  PUTMATCH(13)
  GETMACK()
  STOPR()
  RETURN

; --- END OF D:KCOM850.ACT ---

;<<<D:KERMIT.ACT>>>
;<COMPILE THIS FILE>
; KERMIT protocol
; for Atari Home Computers
; version 1.2
; (C) 1984 John Howard Palevich
; to be distributed free of charge
;
;Started September 24, 1983

;Start code above T: and/or R:
;by compiling while those devices
;are in RAM.  There ought to be a
;better way!

MODULE

DEFINE MAXPACK = "94"

BYTE ARRAY
  RECPKT(MAXPACK),
  PACKET(MAXPACK),
  FILNAM,
  SBUF(2050)

DEFINE
  EOF = "-1",
  SOH = "1",
  CR = "13",

  MAXTRY = "5",
  MYQUOTE = "'#",
  TRUE = "1",
  FALSE = "0"

BYTE
  LMARGN = $52,;OS LEFT MARGIN
  CH = 764,    ;OS CH VARIABLE
  RTCLOCK = 20,;OS CLOCK IN JIFFYS
  CRSINH = $2F0, ;OS CURSOR INHIBIT FLAG
  BACKS,       ;CHAR TO SEND FOR BACK S
  baud,        ;baud rate variable
  dial,        ;nz for tone dialing
  DISKN,       ;DEFAULT DISK
  DNUM,        ;port num
  localecho,   ;local echo flag
  PARITY,      ;communication parity
  ERRORNUM,    ;ERROR NUMBER
  debug,       ;debugging flag

  STATE,
  PADCHAR,
  EOL,
  QUOTE

INT
  SIZE,
  N,
  RPSIZ,
  SPSIZ,
  PAD,
  TIMINT,
  NUMTRY,
  OLDTRY,
  FD,
  REMFD,
  IMAGE,
  HOST

INCLUDE "D:KIO.ACT"

; This is where KCOM#.ACT is
;included.  Include the KCOM file
;which matches the comunications
;device and/or modem you wish to use.
;
; For an 850 and a Hayes SmartModem,
;include KCOM850.ACT
;
; For the ATARI 1050,
;include KCOM1050.ACT
;
; For any other set of devices, write
;your own KCOM functions, and include
;that file here.

INCLUDE "D:KCOM850.ACT"

INCLUDE "D:KFUNC.ACT"
INCLUDE "D:KPRO.ACT"
INCLUDE "D:KTTY.ACT"
INCLUDE "D:KMENU.ACT"

; --- END OF D:KERMIT.ACT ---

;<<<D:KFUNC.ACT>>>
; Utility functions for Kermit
; (C) 1983 John Howard Palevich
; to be distributed free of charge
;
;Started September 24, 1983

MODULE

CARD ARRAY bauds = [300 600 1200
                    1800 2400 4800
                    9600]

PROC SHOWBUF(STRING BUF, INT LEN)
  INT I
  FOR I = 0 TO LEN-1 DO
    PUT(27)
    PUT(BUF(I))
  OD
  RETURN

PROC MERROR(BYTE A,X,Y)
  IF debug = 1 THEN
    PRINTF("ERROR %B%E", y)
    IF Y = 128 THEN
      CLOSE(2)
      CLOSE(3)
      CLOSE(1)
      BREAK()
    FI
  FI
  ERRORNUM = Y
  RETURN

CARD FUNC DecodeBaud(BYTE b)
  STRING buf(6)
  STRC(bauds(b), buf)
  RETURN(buf)

CARD FUNC DecodeFlag(BYTE f)
  IF f = 0 THEN
    RETURN("off")
  ELSE
    RETURN("on")
  FI

BYTE FUNC IsAlpha(BYTE c)
  IF (c >= 'a AND c <= 'z) OR
     (c >= 'A AND c <= 'Z)
  THEN
    RETURN(1)
  ELSE
    RETURN(0)
  FI

BYTE FUNC ToUpper(BYTE c)
  IF c >= 'a AND c <= 'z THEN
    RETURN(c - 32)
  ELSE
    RETURN(c)
  FI

;SPack()
;
; Send a Packet

PROC SPack(BYTE TY
           INT NUM, LEN
           STRING DATA)
  INT I, BUFP
  BYTE CHKSUM
  STRING BUFFER(100)

  IF DEBUG = 1 THEN
    PRINTF("SPack('%C,%D,%D,",
      TY, NUM, LEN)
    PUT('")
    SHOWBUF(DATA, LEN)
    PRINTF("%C)%E", '")
  ELSE
    PUT('.)
  FI

  FOR I = 1 TO PAD
  DO
    PUTD(2, PADCHAR)
  OD

  BUFFER(0) = SOH
  BUFFER(1) = 32 + LEN+3
  BUFFER(2) = 32 + NUM
  BUFFER(3) = TY

  CHKSUM = BUFFER(1)+BUFFER(2)
    +BUFFER(3)

  FOR I = 0 TO LEN-1
  DO
    BUFFER(I+4) = DATA(I)
    CHKSUM ==+ DATA(I)
  OD

  CHKSUM = (CHKSUM + ((CHKSUM & 192)
    RSH 6)) & 63
  BUFFER(LEN+4) = 32 + CHKSUM
  BUFFER(LEN+5) = EOL
  CIOV(2, 11, BUFFER, LEN+6, -1, -1)
  RETURN

;GetRT
; Get a byte from R: with timeout
; and user-abort

BYTE FUNC GetRT(BYTE POINTER B)
  CHAR FSC = 19, TIMER

  TIMER = FSC+3
  WHILE NCIB() = 0 DO
    IF FSC = TIMER THEN
      IF DEBUG = 1 THEN ;say timeout
        PRINTE("(Timeout)")
      FI
      RETURN(0)
    ELSEIF CH <> $FF THEN ;User abort
      RETURN(0)
    FI
  OD
  B^ = GETD(2)
  RETURN(1)

; RPack()
;
; Read a Packet

INT FUNC RPack(INT POINTER LEN, NUM
           STRING DATA)
  INT I, DONE
  CHAR CHKSUM, T, UT, TY

  IF DEBUG = 1 THEN
    PRINT("RPack")
  FI

  DO
    IF GETRT(@T) = 0 THEN
      RETURN(0)
    FI
    IF DEBUG = 1 AND T <> SOH THEN
      PUT(27)
      PUT(T)
    FI
  UNTIL
    T = SOH
  OD
  DONE = FALSE
  WHILE DONE = FALSE
  DO
    IF GETRT(@T) = 0 THEN
      RETURN(0)
    FI
    IF IMAGE = FALSE
    THEN
      T ==& 127
    FI
    IF T <> SOH THEN   ;GOT LEN
      CHKSUM = T
      LEN^ = T-3-32

      IF GETRT(@T) = 0 THEN
        RETURN(0)
      FI
      IF IMAGE = FALSE
      THEN
        T ==& 127
      FI
      IF T <> SOH THEN ;GOT NUM
        CHKSUM ==+ T
        NUM^ = T - 32

        IF GETRT(@T) = 0 THEN
          RETURN(0)
        FI
        IF IMAGE = FALSE THEN T ==& 127 FI
        IF T <> SOH THEN
          CHKSUM ==+ T
          TY = T

          FOR I = 0 TO LEN^-1 DO
            IF GETRT(@T) = 0 THEN
              RETURN(0)
            FI
            IF IMAGE = FALSE THEN T ==& 127 FI
            IF T = SOH THEN EXIT FI
            CHKSUM ==+ T
            DATA(I) = T
          OD

          IF T <> SOH THEN
            IF GETRT(@T) = 0 THEN
              RETURN(0)
            FI
            IF IMAGE <> TRUE THEN T ==& 127 FI
            IF T <> SOH THEN
              DONE = TRUE
            FI
          FI
        FI
      FI
    FI
  OD
  CHKSUM = (CHKSUM +
    ((CHKSUM & 192) RSH 6)) & 63
  UT = T - 32
  IF CHKSUM <> UT THEN
    IF DEBUG = 1 THEN
      PRINTF("(Bad checksum: %D <> %D)%E",
        CHKSUM, UT)
    FI
    RETURN(FALSE)
  FI
  IF DEBUG = 1 THEN ;give type
    PRINTF("('%C%C,%D,%D,%C",
      27, TY, NUM^, LEN^, '")
    SHOWBUF(DATA, LEN^)
    PRINTF("%C)%E", '")
  FI
  IF TY = 'E THEN
    PRINT("Error: ")
    SHOWBUF(DATA, LEN^)
    PUTE()
  FI
  RETURN(TY)

;BuFill
;
;Get a bufferful of data from the
;file that's being sent.  Only
;control-quoting is done;  8-bit &
;repeat count prefixes arn't handled

INT FUNC BuFill(STRING BUFFER)
  INT I
  BYTE T,T7
  STOPR()
  I = 0
  DO
    T = GETD(3)
    IF MStatus(3) >= 128 THEN
      IF DEBUG = 1 THEN
        PRINTE("End-of-file")
      FI
      EXIT
    FI
    IF IMAGE = TRUE THEN
      T7 = T & 127
      IF T7 < 32 OR T7 = 127 OR
        T7 = QUOTE
      THEN
        BUFFER(I) = QUOTE
        I ==+ 1
        IF T7 <> QUOTE THEN
          T ==! 64
        FI
      FI
    ELSE
      IF T <> 155 THEN T ==& 127 FI
      IF T < 32 OR T = 127
        OR T = QUOTE OR T = 155
      THEN
        IF T = 155 THEN
          BUFFER(I) = QUOTE
          BUFFER(I+1) = 13 ! 64
          I ==+ 2
          T = 10
        FI
        BUFFER(I) = QUOTE
        I ==+ 1
        IF T <> QUOTE THEN T==! 64 FI
      FI
    FI
    BUFFER(I) = T
    I ==+ 1
    IF I >= SPSIZ-8 THEN
      STARTR()
      RETURN(I)
    FI
  OD
  STARTR()
  IF I = 0
  THEN
    RETURN(EOF)
  ELSE
    RETURN(I)
  FI

;BufEmp
;
;Get data from an incomming packet
;into a file.

PROC BufEmp(STRING BUFFER
                INT LEN)

  INT I
  BYTE T

  STOPR()
  FOR I = 0 TO LEN-1
  DO
    T = BUFFER(I)
    IF T = MYQUOTE
    THEN
      I ==+ 1
      T = BUFFER(I)
      IF (T & 127) <> MYQUOTE
      THEN
        T ==! 64
      FI
    FI
    IF IMAGE = TRUE THEN
      PUTD(3, T)
    ELSEIF T = CR THEN
      PUTD(3, 155)
    ELSEIF T <> 10 THEN
      PUTD(3, T)
    FI
  OD
  STARTR()
  RETURN

;SPar()
;
;Fill the data array with my
;send-init parameters

PROC SPar(STRING DATA)
  DATA(0) = 32 + MAXPACK
  DATA(1) = 32 + 5
  DATA(2) = 32 + 0
  DATA(3) = 64 ! 0
  DATA(4) = 32 + 13
  DATA(5) = MYQUOTE
  RETURN

;RPar()
;
;Get the other host's send-init
;parameters

PROC RPAR(STRING DATA)
  SPSIZ = DATA(0) - 32
  TIMINT = DATA(1) - 32
  PAD = DATA(2) - 32
  PADCHAR = DATA(3) ! 64
  EOL = DATA(4) - 32
  QUOTE = DATA(5)
  RETURN

; --- END OF D:KFUNC.ACT ---

;<<<D:KIO.ACT>>>
; I/O routines for kermit
; (C) 1983 John Howard Palevich

DEFINE STRING = "BYTE ARRAY"

STRING iocb
CARD filenumber

STRING dname(20), fname(20)

;WAIT T 60THS OF A SECOND

PROC WAIT(INT T)
  BYTE I
  WHILE T > 255
  DO
    I = RTCLOCK-1
    WHILE I <> RTCLOCK DO OD
    T ==- 255
  OD
  I = RTCLOCK + T
  WHILE I <> RTCLOCK DO OD
  RETURN

PROC STRCPY(STRING A, B)
  CARD I
  FOR I = 1 TO B(0) DO
  A(I) = B(I)
  OD
  A(0) = B(0)
  RETURN

BYTE FUNC MStatus(BYTE ch)
  iocb = $340 + ch LSH 4
  RETURN (iocb(3))

PROC CIO=$E456(BYTE a, x)

PROC CIOV(BYTE ch, cmd
          CARD adr, len
          INT ax1, ax2)

  iocb = $340 + ch LSH 4
  iocb(2) = cmd
  iocb(4) = adr
  iocb(5) = adr RSH 8
  iocb(8) = len
  iocb(9) = len RSH 8
  IF ax1 >= 0 THEN
    iocb(10) = ax1
  FI
  IF ax2 >= 0 THEN
    iocb(11) = ax2
  FI

  CIO(0, CH * 16)
  RETURN

;Do a Get Status Command
BYTE FUNC MDevStat(BYTE ch
                   STRING adr)
  CIOV( ch, $0D,
        adr + 1, adr(0), -1, -1)
  RETURN(iocb(3))

; -- file locking, unlocking, etc.
; -- directory hacking functions

;Returns 0 if EOF, else the file name
CARD FUNC GetNext(CHAR ch)
  INT I, J
  STRING DSPEC(20)
  Close(ch)
  Open(ch, dname, 6, 0)
  IF mstatus(ch) >= 128
  THEN
    RETURN(0)
  FI

  FOR i = 0 TO filenumber
  DO
    INPUTMD(ch, DSPEC, 20)
    IF mstatus(ch) >= 128 THEN
      Close(ch)
      RETURN(0)
    FI
  OD
  IF DSPEC(0) <> 17 THEN RETURN(0) FI
  filenumber ==+ 1
  Close(ch)
  ;Convert dspec into file name
  I = 1
  DO
    FNAME(I) = DNAME(I)
    I ==+ 1
  UNTIL
    DNAME(I-1) = ':
  OD

  J = 3
  DO
    FNAME(I) = DSPEC(J)
    I ==+ 1
    J ==+ 1
  UNTIL
    J > 10 OR DSPEC(J) = 32
  OD
  FNAME(I) = '.
  I ==+ 1
  J = 11
  WHILE
    J <= 13 AND DSPEC(J) <> 32
  DO
    FNAME(I) = DSPEC(J)
    I ==+ 1
    J ==+ 1
  OD

  FNAME(0) = I-1
  RETURN(fname)

;Get the first name

CARD FUNC GetFirst(BYTE ch
                   STRING name)

  STRCPY(dname, NAME)
  filenumber = 0
  RETURN(GetNext(ch))

;FIND CHAR C IN STRING A

BYTE FUNC FindC(STRING a
           BYTE c)
  CARD i,l
  l = a(0)
  FOR i = 1 TO l DO
    IF a(i) = c THEN
      EXIT
    FI
  OD
  RETURN(i)

;Normalize a file name string to Dn:<0..8>.<0..3>
;where n is the value of diskn
;name should be at least 3+8+1+3+2=17 bytes long
;returns 0 if not a valid name

BYTE FUNC Normalize(STRING name)
  CARD i, len
  BYTE C


  len = name(0)
  IF len = 0 THEN
    RETURN(0)
  FI

;first, check if <letter>(<number>):

  i = FindC(name,':)
  IF i > len THEN
    FOR i = 1 TO len DO
      name(len-i+4) = name(len-i+1)
    OD
    name(1) = 'D
    name(2) = '0 + DISKN
    name(3) = ':
    len ==+ 3
  FI

;fixup length
  name(0) = len

;and convert to upper case

  FOR i = 1 TO len DO
    c = name(i)
    IF c >= 'a AND c <= 'z THEN
      name(i) = c - 32
    FI
  OD

  RETURN(1)

BYTE FUNC INSET(BYTE C STRING S)
  CARD I
  FOR I = 1 TO S(0)
  DO
    IF C = S(I) THEN
      RETURN(I)
    FI
  OD
  RETURN(0)

; --- END OF D:KIO.ACT

;<<<D:KMENU.ACT>>>
; Menu functions of Kermit program

MODULE
  DEFINE NUMWID = "38"

  STRING PNFILE = "D:KERMIT.PNS"
  STRING PARAMFILE = "D:KERMIT.OPT"

;Restore Phone Number Buffer

PROC RESTNUMS()
  BYTE I, J

  Close(3)
  ERRORNUM = 0
  OPEN(3, PNFILE, 4, 0)
  IF ERRORNUM < 128 THEN
    FOR I = 0 TO 19 DO
      ERRORNUM = 0
      InputMD(3,SBUF+I*NUMWID, 37)
      IF ERRORNUM >= 128 THEN
        EXIT
      FI
    OD
  ELSE
    I = 0 ;Couldn't find file
  FI
  CLOSE(3)

  FOR J = I TO 19
  DO
    SBUF(NUMWID*J) = 0
  OD
  RETURN

;Display the editor screen

PROC DispES()
  BYTE I

  ;Display Screen
  CRSINH = 1
  PUT(125)

  PRINTE("Computer Name (baud rate) # 555-1212")
  FOR I = 0 TO 19
  DO
    Put(32)
    PRINTE(SBUF+NUMWID*I)
  OD

  PrintE("Use arrows, then RETURN to dial,")
  PrintE("or ESC to quit. ^S Saves")
  PRINT("SPACE modifies, ^R Restores")
  Position(LMARGN, 0)
  Put($1F)
  CRSINH = 0
  Put($1E)
  RETURN

;Auto-Dial a number, return 1 if
;successful, 0 if failure
;
; Also has provisions for editing
; phone numbers.

BYTE FUNC EditDial()
  BYTE I, NN, C, CY
  BYTE POINTER P

  RESTNUMS()
  DISPES()
  CY = 0

  ;Edit/Select Loop

  DO
    CRSINH = 1
    POSITION(LMARGN, CY+1)
    PUT(27)
    PUT($1F)
    C = GetD(1)
    IF C = 32 THEN
    ;User wants to change this line
      POSITION(LMARGN,CY+1)
      CRSINH = 0
      PUT('?)
      InputMD(0,SBUF+CY*NUMWID, 37)
      DISPES()

    ELSEIF C = 27 THEN
      Position(LMARGN, 23)
      CRSINH = 0
      PUT($9C)
      PrintE("Not Dialing")
      RETURN(0)

    ELSEIF (C = $1C OR C = '-)
      AND CY > 0 THEN
      PUT($7E) ;Erase the arrow
      CY ==- 1

    ELSEIF (C = $1D OR C = '=)
      AND CY < 19 THEN
      PUT($7E) ;Erase the arrow
      CY ==+ 1

    ELSEIF C = 'S-'@ THEN ;^S
      OPEN(3, PNFILE, 8, 0)
      FOR I = 0 TO 19 DO
        P = SBUF+I*NUMWID
        IF P(0) > 0 THEN
          PRINTDE(3, P)
        FI
      OD
      CLOSE(3)
      RESTNUMS()
      DISPES() ;Just to inform user
      CY = 0

    ELSEIF C = 'R-'@ THEN ;^R
      RESTNUMS()
      DISPES()
      CY = 0

    ELSEIF C = $9B THEN ;RETURN
      EXIT
    FI
  OD

  ;Dial the chosen number

  CRSINH = 0
  PUT(125)
  P = SBUF+CY*NUMWID
  PrintE(P)
  C = AutoDial(P)
  RETURN(C)

;Execute a DOS-type command

PROC DODOS(BYTE CMD
           STRING FSPEC)
  STRING FMSCOM = [0 $21 $23 $24 $FE]
  STRING FILNAM(21)
  BYTE I, CNF

  IF FSPEC(0) = 0 AND CMD <> 'A THEN
    RETURN
  FI

  IF CMD = 'A THEN     ;DIRECTORY
    IF FSPEC(0) = 0 THEN
      STRCPY(FSPEC, "D#:*.*")
      FSPEC(2) = '0 + DISKN
    FI

    NORMALIZE(FSPEC)
    CLOSE(6)
    ERRORNUM = 0
    OPEN(6, FSPEC, 6, 0)
    DO
      INPUTMD(6, FILNAM, 20)
      IF ERRORNUM >= 128 THEN EXIT FI
      PRINTE(FILNAM)
      IF FILNAM(1) >= '0 AND
         FILNAM(1) <= '9
      THEN EXIT FI
    OD
    CLOSE(6)

  ELSE         ;ALL OTHER COMMANDS
    NORMALIZE(FSPEC)
    I = INSET(CMD, "DFGI")
    IF I = 0 THEN RETURN FI
    IF CMD = 'I
    THEN
      PRINTF("Type 'Y' to format %S%E",
        FSPEC)
      CNF = GetD(1)
      IF TOUPPER(CNF) <> 'Y
      THEN
        PRINTF("Aborted%E")
        RETURN
      ELSE
        PRINT("Formatting. . .")
      FI
    FI
    ERRORNUM = 0
    XIO(6, 0, FMSCOM(I), 0, 0, FSPEC)
    IF ERRORNUM >= 128
    THEN
      PRINTF("Disk I/O error %B%E",
        ERRORNUM)
    FI
  FI
  RETURN

PROC MICRODOS()
  BYTE cmd
  STRING fspec(21)
  PUT(125)
  DO
    PRINTE("Micro-DOS:")
    PRINTE(" A - Disk Directory")
    PRINTE(" D - Delete File")
    PRINTE(" F - Lock File")
    PRINTE(" G - Unlock File")
    PRINTE(" I - Format Diskette")
    PRINTE(" Q - Quit (back to main menu)")
    PRINTF("%ECommand -> ")
    DO
      cmd = GetD(1)
      cmd = ToUpper(cmd)
    UNTIL
      INSET(CMD, "ADFGIQ") > 0
    OD

    PUT(CMD)
    IF cmd = 'Q
    THEN
      PUTE()
      RETURN
    FI
    PRINTF("%EFile spec -> ")
    InputMD(0, fspec, 20)
    DoDos(cmd, fspec)
  OD

; SAVE PARAMETERS

PROC SaveParams()
  ERRORNUM = 0
  OPEN(3, PARAMFILE, 8, 0)
  IF ERRORNUM < 128
  THEN         ;Can write
    PUTD(3, BACKS)
    PUTD(3, BAUD)
    PUTD(3, DISKN)
    PUTD(3, DEBUG)
    PUTD(3, IMAGE)
    PUTD(3, LOCALECHO)
    PUTD(3, LMARGN)
    PUTD(3, PARITY)
    PUTD(3, DNUM)
    PUTD(3, dial)
  FI
  CLOSE(3)
  RETURN


;RESTORE PARAMETERS

PROC RestoreParams()
  CARD TEMP
  CLOSE(3)
  ERRORNUM = 0
  OPEN(3, PARAMFILE, 4, 0)
  IF ERRORNUM >= 128
  THEN         ;Defaults
    PRINTF("Couldn't open %S; error %D%E",
      PARAMFILE, ERRORNUM)
    BACKS = 127          ;RUB OUT
    baud = 0             ;300 baud
    DISKN = 1            ;D1:
    debug = 0            ;debug off
    IMAGE = 0            ;TEXT
    localecho = 0        ;full
    LMARGN = 2           ;2 CHARS
    PARITY = 0           ;NO PARITY
    DNUM = 1             ;PORT 1
    dial = 0             ;Pulse
  ELSE
    BACKS = GETD(3)
    BAUD = GETD(3)
    DISKN = GETD(3)
    DEBUG = GETD(3)
    IMAGE = GETD(3)
    LOCALECHO = GETD(3)
    LMARGN = GETD(3)
    PARITY = GETD(3)
    DNUM = GETD(3)
    DIAL = GETD(3)
  FI
  CLOSE(3)
  RETURN

;SET PARAMETERS

PROC Params()
  BYTE cmd
  STRING ts

  DO
    Put(125)
    PRINTE("Parameters are:")

    IF BACKS = 8 THEN
      TS = "control-H"
    ELSE TS = "rub out"
    FI
    PRINTF(" A - Back S sends (%S)%E",
      ts)

    ts = DecodeBaud(baud)
    PRINTF(" B - Baud rate (%S)%E",
      TS)

    IF IMAGE = 0 THEN
      ts = "text"
    ElSE
      ts = "binary"
    FI

    PRINTF(" D - Default disk drive (D%D:)%E",
      diskn)

    PRINTF(" F - File type (%S)%E",
      ts)

    PRINTF(" I - I/O Port (%D)%E",
      DNUM)

    IF dial = 0 THEN
      ts = "pulse"
    ELSE
      ts = "tone"
    FI
    PRINTF(" T - Dialing method (%S)%E",
      ts)

    ts = DecodeFlag(localecho)
    PRINTF(" L - Local-Echo (%S)%E",
      ts)

    PRINTF(" M - Margin (%D)%E", LMARGN)


    IF PARITY = 0 THEN
      TS = "none"
    ELSEIF PARITY = 1 THEN
      TS = "odd"
    ELSEIF PARITY = 2 THEN
      TS = "even"
    ELSEIF PARITY = 3 THEN
      TS = "on"
    FI
    PRINTF(" P - Parity (%S)%E", ts)

    PRINTE("^S - Save parameters")
    PRINTE("^R - Restore paramters")

    ts = DecodeFlag(debug)
    PRINTF(" * - Debug Mode (%S)%E",
      ts)

    PRINTF(" Q - Quit (back to Commands)%E")

    PRINTF("Parameter to change -> ")
    cmd = GetD(1)
    cmd = ToUpper(cmd)
    IF IsAlpha(cmd) <> 0 THEN
      Put(cmd)
    FI

    IF CMD = 'A THEN     ;BACK S
      IF BACKS = 8 THEN
        BACKS = 127
      ELSE
        BACKS = 8
      FI

    ELSEIF cmd = 'B THEN ;Baud-rate
      baud ==+ 1
      IF baud > 6 THEN baud = 0 FI

    ELSEIF cmd = 'D THEN ;Disk number
      diskn ==+ 1
      IF diskn > 4 THEN diskn = 1 FI

    ELSEIF cmd = '* THEN ;Debug
      debug = 1-debug

    ELSEIF cmd = 'Q THEN ;Quit
      PRINTF("uit%E")
      RETURN

    ELSEIF cmd = 'F THEN ;File type
      IMAGE = 1-IMAGE

    ELSEIF cmd = 'L THEN ;local-echo
      localecho ==+ 1
      IF localecho > 1 THEN
        LOCALECHO = 0
      FI

    ELSEIF cmd = 'T THEN ;dialing
      DIAL ==+ 1
      IF DIAL > 1 THEN
        DIAL = 0
      FI

    ELSEIF CMD = 'M THEN ;Margin
      LMARGN ==+ 1
      IF LMARGN > 2 THEN
        LMARGN = 0
      FI

    ELSEIF CMD = 'P THEN ;PARITY
      PARITY ==+ 1
      IF PARITY > 3 THEN
        PARITY = 0
      FI

    ELSEIF cmd = 'I THEN ;Port #
      dnum ==+ 1
      IF dnum > 4 THEN dnum = 1 FI

    ELSEIF cmd = 'S-'@ THEN ;Save Parameters
      PRINTE("Saving")
      SAVEPARAMS()

    ELSEIF cmd = 'R-'@ THEN ;Restore parameters
      PRINTE("Restoring")
      RESTOREPARAMS()

    ELSE
      PUT(253)
    FI
  OD

PROC Main()
  BYTE cmd, FLAG, I, BANK = $D500

  BANK = 0

  ;SETUP MY ERROR ROUTINE
  ERROR = MERROR

  EOL = CR
  QUOTE = MYQUOTE
  PAD = 0
  PADCHAR = 0
  HOST = FALSE

  FOR I = 1 TO 7 DO
    CLOSE(I)
  OD

  PRINTE("Kermit for the Atari Home Computer")
  PRINTE("v1.2 (c) 1984 John Howard Palevich")
  MODEMINIT()
  PRINTE("- Feel free to copy this program -")

  RestoreParams()
  Open(1, "K:", 4, 0)
  IF OPENR() <> 0 THEN
    PRINTE("PRESS ANY KEY TO EXIT")
    CH = $FF
    WHILE CH = $FF DO OD
    CH = $FF
  ELSE
    STOPR()

    DO
      PRINTF("%E%ECommands are:%E")
      PRINTE(" A - Auto-dial (then connect)")
      PRINTE(" C - Connect (to remote computer)")
      PRINTE(" D - Micro-DOS")
      PRINTE(" F - Finish (remote server mode)")
      PRINTE(" H - Hang up (the phone)")
      PRINTE(" P - Parameters (inspect and change)")
      PRINTE(" R - Receive (a file)")
      PRINTE(" S - Send (a file)")
      PRINTF(" Q - Quit (back to DOS)%E%E")
      PRINTF("Command -> ")
      DO
        cmd = GetD(1)
        cmd = ToUpper(cmd)
      UNTIL INSET(CMD, "ACDFHPRSQ") <> 0
      OD
      Put(cmd)

      IF CMD = 'A THEN
        ;Auto-dial
        PRINTE("uto-dial")
        IF EditDial() = 1 THEN
          TTYMODE()
        FI

      ELSEIF cmd = 'C THEN ;connect
        PRINTE("onnect")
        TTYMODE()

      ELSEIF cmd = 'F THEN ;Finish
        PRINTE("inish")
        Finish()

      ELSEIF cmd = 'H THEN
        ;Hang up the phone
        PRINTE("ang up")
        HangUp()

      ELSEIF cmd = 'D THEN ;MICRO-DOS
        PRINTE("os")
        MICRODOS()

      ELSEIF cmd = 'Q THEN ;Quit
        PRINTE("uit")
        EXIT

      ELSEIF cmd = 'P THEN ;Parameters
        PRINTE("arameters")
        Params()

      ELSEIF cmd = 'S THEN ;Send
        PRINTE("end")
        SENDSW()

      ELSEIF cmd = 'R THEN ;Recieve
        PRINTE("ecieve")
        RECSW()
      FI
    OD

    CLOSER()
  FI
  CLOSE(1)
  RETURN

;--- END OF D:KMENU.ACT ---

;<<<D:KPRO.ACT>>>
; KERMIT protocol section

; RInit()
;
; Receive Initialization

BYTE FUNC RINIT(STRING FSPEC)
  INT LEN, NUM, T
  IF DEBUG = 1 THEN
    PRINTE("RInit")
  FI

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN
    RETURN('A)
  FI

  IF FSPEC(0) > 0 THEN
    FOR T = 1 TO FSPEC(0)
    DO
      PACKET(T-1) = FSPEC(T)
    OD
    SPACK('R, 0, T-1, PACKET)
  FI

  T = RPACK(@LEN, @NUM, PACKET)
  IF T = 'S THEN
    RPAR(PACKET)
    SPAR(PACKET)
    SPACK('Y, N, 6, PACKET)
    OLDTRY = NUMTRY
    NUMTRY = 0
    N = (N + 1) MOD 64
    RETURN('F)

  ELSEIF T = FALSE THEN RETURN(STATE)
  ELSE RETURN('A)
  FI

; RFile()
;
; Receive File Header

BYTE FUNC RFile()
  INT LEN, NUM, T
  BYTE W
  IF DEBUG = 1 THEN
    PRINTF("RFile%E")
  FI

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN
    RETURN('A)
  FI

  T = RPACK(@LEN, @NUM, PACKET+1)
  PACKET(0) = LEN
  IF T = 'S THEN
    OLDTRY ==+ 1
    IF OLDTRY > MAXTRY THEN RETURN('A) FI
    IF (N = 0 AND NUM = 63)
      OR (N <> 0 AND NUM = N-1)
    THEN
      SPACK('Y, NUM, 0, 0)
      NUMTRY = 0
      RETURN(STATE)
    ELSE
      RETURN('A)
    FI

  ELSEIF T = 'F THEN
    IF NUM <> N THEN RETURN('A) FI
    STOPR()
    NORMALIZE(PACKET)
    ERRORNUM = 0
    OPEN(3, PACKET, 8, 0)
    STARTR()
    IF ERRORNUM >= 128
    THEN
      PRINTF("Couldn't create %S; error %D%E",
        PACKET, ERRORNUM)
      RETURN('A)
    FI
    PRINTF("Receiving %S%E",
      PACKET)
    SPACK('Y, N, 0, 0)
    OLDTRY = NUMTRY
    NUMTRY = 0
    N = (N+1) MOD 64
    RETURN('D)

  ELSEIF T = 'B THEN
    IF NUM <> N THEN RETURN('A) FI
    SPACK('Y, N, 0, 0)
    ;WAIT 1 SECOND FOR ACK TO DRAIN
    W = RTCLOCK+60
    WHILE W <> RTCLOCK DO OD
    RETURN('C)

  ELSEIF T = FALSE THEN RETURN(STATE)
  ELSE RETURN('A)
  FI

; RData()
;
; Receive Data

BYTE FUNC RData()
  INT NUM, LEN, T
  IF DEBUG = 1 THEN
    PRINTF("RData%E")
  FI

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN
    RETURN('A)
  FI

  T = RPACK(@LEN, @NUM, PACKET)
  IF T = 'D THEN
    IF NUM <> N
    THEN
      OLDTRY ==+ 1
      IF OLDTRY > MAXTRY THEN RETURN('A) FI
      IF (N = 0 AND NUM = 63)
        OR (N <> 0 AND NUM = N-1)
      THEN
        SPACK('Y, NUM, 0, 0)
        NUMTRY = 0
        RETURN(STATE)
      ELSE
        RETURN('A)
      FI
    FI

    BUFEMP(PACKET, LEN)
    SPACK('Y, N, 0, 0)
    OLDTRY = NUMTRY
    NUMTRY = 0
    N = (N+1) MOD 64
    RETURN('D)

  ELSEIF T = 'F THEN
    OLDTRY ==+ 1
    IF OLDTRY > MAXTRY THEN
      RETURN('A)
    FI
    IF (N = 0 AND NUM = 63)
      OR (N <> 0 AND NUM = N-1)
    THEN
      SPACK('Y, NUM, 0, 0)
      NUMTRY = 0
      RETURN(STATE)
    ELSE
      RETURN('A)
    FI

  ELSEIF T = 'Z THEN
    IF NUM <> N THEN RETURN('A) FI
    IF DEBUG = 1 THEN
      PRINTE("End-of-File")
    FI
    STOPR()
    CLOSE(3)
    STARTR()
    SPACK('Y, N, 0, 0)
    N = (N+1) MOD 64
    RETURN('F)

  ELSEIF T = FALSE THEN RETURN(STATE)
  ELSE RETURN('A)
  FI

; RecSw()
;
; This is the state table switcher
; for receiving files

PROC RECSW()
  STRING FSPEC(20)
  INT NUM, LEN, T

  STARTR()
  PUT(125)
  PRINTE("Type the file to receive, or just")
  PRINTE("RETURN if the other computer is not")
  PRINTE("in Server mode.")
  PUTE()
  PRINT("File Spec -> ")
  INPUTMD(0, FSPEC, 19)

  PRINTE("Receiving File(s)")
  PRINTE("type any key to abort")

  STATE = 'R
  N = 0
  NUMTRY = 0
  DO
    IF CH <> 255 THEN
      PRINTE("User Aborting")
      CH = 255
      EXIT
    FI
    IF STATE = 'D THEN STATE = RDATA()
    ELSEIF STATE = 'F THEN STATE = RFILE()
    ELSEIF STATE = 'R THEN STATE = RINIT(FSPEC)
    ELSEIF STATE = 'A THEN
      PRINTE("Aborting")
      EXIT
    ELSE
      EXIT
    FI
  OD
  STOPR()
  Close(3)
  RETURN

; SInit
;
; Send Initiate:
;  Send my parameters, get other
;  side's back

BYTE FUNC SINIT()
  INT NUM, LEN
  BYTE T

  IF DEBUG <> 0 THEN
    PRINTF("SInit%E")
  FI

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN
    RETURN('A)
  FI
  SPAR(PACKET)
  IF DEBUG <> 0 THEN
    PRINTF("n = %D%E", N)
  FI
  ;Clear out any junk in the input
  ;buffer
  WHILE NCIB() > 0 DO GETD(2) OD

  SPACK('S, N, 6, PACKET)
  T = RPACK(@LEN, @NUM, RECPKT)
  IF     T = 'N THEN RETURN(STATE)
  ELSEIF T = 'Y THEN
    IF N <> NUM THEN
      RETURN(STATE)
    FI
    RPAR(RECPKT)
    IF EOL = 0 THEN
      EOL = 13
    FI
    IF QUOTE = 0 THEN
      QUOTE = '#
    FI
    NUMTRY = 0
    N = (N + 1) MOD 64
    IF FILNAM = 0 THEN
      RETURN('A)
    FI
    ;Open a file
    STOPR()
    ERRORNUM = 0
    Close(3)
    OPEN(3, FILNAM, 4, 0)
    STARTR()
    IF ERRORNUM >= 128 THEN
      PRINTF("Error %D; couldn't read %S",
        ERRORNUM, FILNAM)
      RETURN('A)
    FI
    PRINTF("Sending %S%E", FILNAM)
    RETURN('F)

  ELSEIF T = FALSE THEN RETURN(STATE)
  ELSE RETURN('A)
  FI

; SFile
;
; Send File Header

BYTE FUNC SFILE()
  INT NUM, LEN, T, I
  STRING STFNAME(20)
  IF DEBUG = 1 THEN
    PRINTE("SFile")
  FI

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN RETURN('A) FI

  I = 1        ;STANDARD FILE NAMES DON'T HAVE D1:
  WHILE FILNAM(I) <> ': DO I ==+ 1 OD
  LEN = FILNAM(0)-I
  FOR T = 0 TO LEN-1 DO
    STFNAME(T) = FILNAM(I+T+1)
  OD

  SPACK('F, N, LEN, STFNAME)
  T = RPACK(@LEN, @NUM, RECPKT)
  IF T = 'N OR T = 'Y THEN
    IF T = 'N
    THEN
      NUM ==- 1
      IF NUM < 0 THEN NUM = 63 FI
    FI

    IF N <> NUM
    THEN
      RETURN(STATE)
    FI
    NUMTRY = 0
    N = (N + 1) MOD 64
    SIZE = BUFILL(PACKET)
    IF SIZE = EOF THEN
      RETURN('Z)
    ELSE
      RETURN('D)
    FI
  ELSEIF T = FALSE THEN RETURN(STATE)
  ELSE RETURN('A)
  FI

; SData
;
; Send File Data

BYTE FUNC SData()
  INT NUM, LEN, T

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN
    RETURN('A)
  FI
  SPACK('D, N, SIZE, PACKET)
  T = RPACK(@LEN, @NUM, RECPKT)
  IF T = 'N OR T = 'Y THEN
    IF T = 'N
    THEN
      NUM ==- 1
      IF NUM < 0 THEN NUM = 63 FI
    FI

    IF N <> NUM
    THEN
      RETURN(STATE)
    FI
    NUMTRY = 0
    N = (N + 1) MOD 64
    SIZE = BUFILL(PACKET)
    IF SIZE = EOF THEN
      RETURN('Z)
    FI
    RETURN('D)
  ELSEIF T = FALSE THEN
    RETURN(STATE)
  ELSE RETURN('A)
  FI

; SEOF()
;
; Send End-Of-File

BYTE FUNC SEOF()
  INT NUM, LEN, T

  IF DEBUG = 1 THEN
    PRINTF("SEOF%E")
  FI

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN
    RETURN('A)
  FI
  SPACK('Z, N, 0, PACKET)

  IF DEBUG = 1 THEN
    PRINT("SEOF1 ")
  FI

  T = RPACK(@LEN, @NUM, RECPKT)
  IF T = 'N OR T = 'Y THEN
    IF T = 'N
    THEN
      NUM ==- 1
      IF NUM < 0 THEN NUM = 63 FI
      IF N <> NUM THEN RETURN(STATE) FI
    FI

    IF DEBUG = 1 THEN
      PRINTF("SEOF2 ")
    FI
    IF N <> NUM
    THEN
      RETURN(STATE)
    FI
    NUMTRY = 0
    N = (N + 1) MOD 64
    IF DEBUG = 1 THEN
      PRINTF("Closing %S%E", FILNAM)
    FI
    STOPR()
    IF DEBUG = 1 THEN
      PRINTF("getting next file%E")
    FI
    DO
      FILNAM = GETNEXT(6)
      IF FILNAM = 0 THEN EXIT FI
      CLOSE(3)
      ERRORNUM = 0
      OPEN(3,FILNAM, 4, 0)
      IF ERRORNUM < 128 THEN
        EXIT
      ELSE
        PRINTF("Can't read %S; Error %D%E",
          FILNAM, ERRORNUM)
      FI
    OD

    STARTR()
    IF FILNAM = 0 THEN
      RETURN('B)
    FI
    PRINTE(FILNAM)
    RETURN('F)
  ELSEIF T = FALSE THEN RETURN(STATE)
  ELSE RETURN('A)
  FI

; SBreak()
;
; Send Break (End-of-Text)

BYTE FUNC SBreak()
  INT NUM, LEN, T

  IF DEBUG = 1 THEN
    PRINTF("SBreak%E")
  FI

  NUMTRY ==+ 1
  IF NUMTRY > MAXTRY THEN
    RETURN('A)
  FI
  SPACK('B, N, 0, PACKET)

  T = RPACK(@LEN, @NUM, RECPKT)
  IF T = 'N OR T = 'Y THEN
    IF T = 'N
    THEN
      NUM ==- 1
      IF NUM < 0 THEN NUM = 63 FI
      IF N <> NUM THEN
        RETURN(STATE)
      FI
    FI

    IF N <> NUM
    THEN
      RETURN(STATE)
    FI

    NUMTRY = 0
    N = (N + 1) MOD 64
    RETURN('C)

  ELSEIF T = FALSE THEN RETURN(STATE)
  ELSE RETURN('A)
  FI

;MAIN SEND FILE ROUTINE

PROC SENDSW()
  STRING FSpec(20)
  DO
    Print("File spec -> ")
    INPUTMD(0, FSPEC, 19)
    IF FSPEC(0) = 0 THEN RETURN FI
    Normalize(FSPEC)
    FILNAM = GETFIRST(6, FSPEC)
    IF FILNAM = 0 THEN
      PRINTE("Invalid file name")
    FI
  UNTIL
    FILNAM <> 0
  OD
  Put(125)
  PRINTF("Sending %S%E", FSpec)
  PRINTE("Type any key to abort.")
  STARTR()

  STATE = 'S
  N = 0
  NUMTRY = 0
  DO
    IF CH <> 255 THEN
      PRINTE("User Abort")
      CH = 255
      EXIT
    FI
    IF     STATE = 'D THEN STATE = SDATA()
    ELSEIF STATE = 'F THEN STATE = SFILE()
    ELSEIF STATE = 'Z THEN STATE = SEOF()
    ELSEIF STATE = 'S THEN STATE = SINIT()
    ELSEIF STATE = 'B THEN STATE = SBREAK()
    ELSEIF STATE = 'A THEN
      PRINTE("Aborting")
      EXIT
    ELSE EXIT
    FI
  OD
  STOPR()
  CLOSE(3)
  RETURN

;Tell Server to quit

PROC Finish()
  INT NUM, LEN, T

  IF DEBUG = 1 THEN
    PRINTE("Finish")
  FI
  STARTR()
  FOR NUMTRY = 0 TO 3
  DO
    PACKET(0) = 'F
    SPACK('G, 0, 1, PACKET)

    T = RPACK(@LEN, @NUM, RECPKT)
    IF T = 'N OR T = 'Y THEN
      IF T = 'N
      THEN
        NUM ==- 1
        IF NUM < 0 THEN NUM = 63 FI
        IF 0 <> NUM THEN
          EXIT
        FI
      FI

      IF 0 = NUM
      THEN
        STOPR()
        RETURN
      FI
    FI
  OD

  STOPR()
  PRINTE("Server didn't respond")
  RETURN

;--------------------------
;Kermit Protocol code ends here
;--------------------------

; --- END OF D:KPRO.ACT ---

;<<<D:KTTY.ACT>>>
; Terminal emulation for the masses
; Emulates a VT-52, Option quits,
; Start scrolls.

MODULE
  CARD ARRAY LBASE(24)
  BYTE ARRAY LCUR(24)

  BYTE CX, CY, LMAR, DLTOGGLE,TSTATE,
       consol = $D01F
  CARD SDLST = $230,
       SAVEDL, HELPLINE

;Create a display list and display it
;
; Uses: LBASE, LCUR, LMAR, SAVEDL,
; Modifies: DLTOGGLE, SCREEN MEMORY

PROC HACKDISPLAY()
  BYTE ARRAY DBASE
  BYTE I
  CARD J, TBASE
  DBASE = DLTOGGLE*85+SAVEDL+72
  DLTOGGLE = 1 - DLTOGGLE
  TBASE = DBASE
  FOR I = 0 TO 2 DO
    DBASE(I) = $70
  OD
  FOR I = 0 TO 23 DO
    DBASE ==+ 3
    DBASE(0) = $42
    J = LCUR(I)
    J = LBASE(J) + LMAR - LMARGN
    DBASE(1) = J
    DBASE(2) = J RSH 8
  OD
  DBASE(3) = $00
  DBASE(4) = $42
  DBASE(5) = HELPLINE
  DBASE(6) = HELPLINE RSH 8
  DBASE(7) = $41
  DBASE(8) = TBASE
  DBASE(9) = TBASE RSH 8
  SDLST = TBASE
  RETURN

PROC CFLIP()
  BYTE POINTER M
  BYTE I
  I = LCUR(CY)
  M = LBASE(I) + CX
  M^ ==! $80
  RETURN

PROC LCLEAR(BYTE LINE)
  BYTE I
  BYTE ARRAY T
  I = LCUR(LINE)
  T = LBASE(I)-2
  FOR I = 0 TO 81 DO
    T(I) = 0
  OD
  RETURN

PROC TINIT()
  CARD I, J
  ;First, find 24 valid lines in
  ;Sbuf.  Valid lines don't cross 4K
  J = SBUF
  FOR I = 0 TO 23
  DO
    IF (J RSH 12) <>
        ((J + 81) RSH 12)
    THEN
      J = (J & $F000) + $1000
    FI
    LBASE(I) = J+2
    J ==+ 82
    LCUR(I) = I ;set up current line order
    LCLEAR(I)
  OD
  ;Now set up a display list
  SAVEDL = SDLST
  HELPLINE = SDLST+32
  PUT(125)
  PRINTE("OPTION quits, (SHIFT)+START scrolls")
  DLTOGGLE = 0
  TSTATE = 'N
  CX = 0
  CY = 0
  LMAR = 0
  CFLIP()
  HACKDISPLAY()
  RETURN

BYTE FUNC TPUTN(BYTE C)
  BYTE I, TEMP
  BYTE POINTER M
  BYTE ARRAY TOSCR = [$40 $00 $20 $60]
  CFLIP()
  IF C < 32 THEN
    IF C = 27 THEN
      RETURN('E)
    ELSEIF C = 10 THEN
      IF CY < 23 THEN
        CY ==+ 1
      ELSE
        LCLEAR(0)
        TEMP = LCUR(0)
        FOR I = 0 TO 22
        DO
          LCUR(I) = LCUR(I+1)
        OD
        LCUR(23) = TEMP
        HACKDISPLAY()
      FI

     ELSEIF C = 13 THEN
       CX = 0

     ELSEIF C = 7 THEN ;BELL
       SETCOLOR(4, 0, 14)
       I = RTCLOCK + 2
       WHILE I <> RTCLOCK DO OD
       SETCOLOR(4, 0, 0)

     ELSEIF C = 8 THEN ;BACKSPACE
       IF CX > 0 THEN
         CX ==- 1
       FI

     ELSEIF C = 9 THEN ;TAB
       IF CX < 72 THEN
         CX = (CX + 8) & $F8
       FI

     ELSEIF C = 12 THEN
       FOR I = 0 TO 23 DO
         LCLEAR(I)
       OD
       CX = 0
       CY = 0

     FI
  ELSE         ;printing char
    I = LCUR(CY)
    M = LBASE(I) + CX
    M^ = TOSCR((C & $60) RSH 5)
      % (C & $9F)
    IF CX < 79 THEN CX ==+ 1
    FI
  FI
  CFLIP()
  RETURN('N)

BYTE FUNC TPUTE(BYTE C)
  BYTE TEMP, I
  BYTE ARRAY M
  IF C = 'A THEN
    IF CY > 0 THEN
      CY ==- 1
    FI

  ELSEIF C = 'B THEN
    IF CY < 23 THEN
      CY ==+ 1
    FI

  ELSEIF C = 'C THEN
    IF CX < 79 THEN
      CX ==+ 1
    FI

  ELSEIF C = 'D THEN
    IF CX > 0 THEN
      CX ==- 1
    FI

  ELSEIF C = 'H THEN
    CX = 0
    CY = 0

  ELSEIF C = 'I THEN
    IF CY > 0 THEN
      CY ==- 1
    ELSE
      LCLEAR(23)
      TEMP = LCUR(23)
      FOR I = 0 TO 22 DO
        LCUR(23-I) = LCUR(22-I)
      OD
      LCUR(0) = TEMP
      HACKDISPLAY()
    FI

  ELSEIF C = 'J OR C = 'K THEN
    I = LCUR(CY)
    M = LBASE(I)
    FOR I = CX TO 79 DO
      M(I) = 0
    OD
    IF C = 'J THEN
      FOR I = CY+1 TO 23 DO
        LCLEAR(I)
      OD
    FI
  ELSEIF C = 'Y THEN
    RETURN('R)
  ELSEIF C = 'Z THEN
    PUTD(2, 27)
    PUTD(2, '/)
    PUTD(2, 'Z)
  FI
  CFLIP()
  RETURN('N)

PROC TPUTSW(BYTE C)
  IF TSTATE = 'N THEN
    TSTATE = TPUTN(C)
  ELSEIF TSTATE = 'E THEN
    TSTATE = TPUTE(C)
  ELSEIF TSTATE = 'R THEN
    IF C < 32 THEN C = 32 FI
    CY = C - 32
    IF CY > 23 THEN CY = 23 FI
    TSTATE = 'C
  ELSEIF TSTATE = 'C THEN
    IF C < 32 THEN C = 32 FI
    CX = C - 32
    IF CX > 79 THEN CX = 79 FI
    CFLIP()
    TSTATE = 'N
  ELSE
    TSTATE = 'N
  FI
  RETURN

PROC TQUIT()
  SDLST = SAVEDL
  PUT(125)
  RETURN

PROC TTYMode()
  BYTE c, SKSTAT = $D20F, OLDSCROLL

  StartR()

  TINIT()
  OLDSCROLL = RTCLOCK - 1
  DO
    IF ch <> $FF THEN
      c = GetD(1)
      IF c = 155 THEN c = 13
      ELSEIF c = 127 THEN c = 9
      ELSEIF c = $7E THEN c = backs
      FI
      PutD(2, c)
      IF localecho = 1 THEN
        TPUTSW(c)
      FI
    FI

    IF ncib() > 0 THEN
      c = GetD(2) & $7F ;strip parity
      TPUTSW(c)
    FI

    consol = 8
    IF (consol & 4) = 0 THEN
      EXIT

    ELSEIF (CONSOL & 1) = 0
      AND RTCLOCK <> OLDSCROLL THEN
      ;START - SHIFT LEFT & RIGHT
      IF (SKSTAT & 8) = 0 THEN
        IF LMAR > 0 THEN
          LMAR ==- 1
        FI
      ELSE
        IF LMAR < 40+LMARGN THEN
          LMAR ==+ 1
        FI
      FI
      HACKDISPLAY()
      OLDSCROLL = RTCLOCK
    FI
  OD
  TQUIT()
  StopR()
  RETURN

;End of D:KTTY.ACT