%include "inc:atdecs.imp"
%include "inc:util.imp"
%include "des:desinc.imp"

%begin
%option "-nocheck"

 {--------------------------------------------------}
 {                                                  }
 { Translated to the devil's own language by F King }
 { For his own use, 30:10:83                        }
 { Copyright M.R.King 1984                          }
 { All rights reserved                              }
 {                                                  }
 {--------------------------------------------------}

%own %string(255) copyright = %c
   "S Editor. Copyright M.R.King, 1984. All rights reserved."

%const %integer buffer size = 255,
                  line size = 127,
                   pat size = 63

@16_3FA0 %byte %integer screen rows
@16_3FA1 %byte %integer screen cols

%integer screen lines = screen rows,
         screen limit = screen rows-1,
         screen size  = screen rows-2,
       screen columns = screen cols

%const %integer bel = 7,
                bs  = 8,
                tab = 9,
                lf  = 10,
                cr  = 13,
                dc4 = 20,
                em  = 25,
                sub = 26,
                esc = 27,
                del = 127

%const %integer control = 0,
                 normal = 1,
               insert c = 2,
               insert l = 3

%string(33) %array help(0:127)

%integer notindenting = 0,
              pending = 0,
                iblim = 0,
                  ibp = 0,
                  obp = 0,
         last command = 0,
         command line = 0,
      in control mode = 0,
            word mode = 0,
         ever changed = 0,
              changed = 0,
             updating = 0,
              cryptin = 0,
             cryptout = 0

%integer h, x, g, zxz, in ptr, out ptr, out start, lbp, y, cx, cy
%integer end line, current n, first line, screen p, indent, mode
%integer backwards, max lines
%string(255) source file, output file, password

%record %format node(%record(node) %name on, back,
                     %byte %integer %array l(1:line size))
%record %format nodedesc(%integer ind, len, %record(node) %name text)
%record(node) nil

%record(node desc) %array screen(1:screen lines)
%record(node) %name head, current, top of stack

%integer copy len, copy pos, copy number, pat len, line num
%byte %integer %array copy line, pattern, ib(1:line size)
%integer %array tab stop(1:line size)
%byte %integer %array default, delimiter(0:127)


%routine raw out(%integer ch)

   print symbol(ch)
%end

%routine raw out string(%string(255) str)
   %integer i

   raw out(charno(str, i)) %for i = 1, 1, length(str)
%end

%routine escape(%integer ch)
  raw out(esc)
  raw out(ch)
%end


%routine end message;

   select output(0)
   escape('Y')
   raw out(' '+screen size-1)
   raw out(' ')
   escape('y')
   %if ever changed#0 %or updating=0 %start
      print string(" Input  file ".source file)
      new line
      print string(" Output file ".output file)
   %else
      new line
      print string(" No changes")
   %finish
   new line
%end; ! of end message

%routine draw box
   %integer i
   escape('F');                  ! { into graphics mode }
   raw out('s');                  ! { Left top }
   raw out('`') %for i = 1, 1, 27;! { horizontal bar }
   raw out('l');                  ! { top right of box }
   escape('B');                  ! { down }
   raw out(bs)
   raw out('a');                  ! { vertical bar }
   raw out(cr)
   raw out('a')
   escape('B')
   raw out(bs)
   raw out('e')
   raw out('`') %for i = 1, 1, 27
   raw out('m')
   raw out(cr)
   escape('A')
   escape('C')
   escape('4')
   raw out('h')
   escape('3')
   raw out(' ')
   escape('G');                ! { return to normal }
%end

{ -------------------------------------------------- }

%predicate init files

   %routine get password(%string(255) %name p)
      %string(255) q, pr
      %on %event 9 %start
         %stop
      %finish

      set terminal mode(noecho)
      pr = "password:"
      %cycle
         prompt(pr)
         read line(p)
         prompt("confirm :")
         read line(q)
         pr = "finger trouble. password:"
      %repeat %until p=q
      prompt("")
   %end


   %integer i, j, ch
   %string(255) params, conpass

   %on %event 3 %start
      raw out(bel)
      print string(source file." does not exist")
      new line
      %false
   %finish

   select input(0)
   params = cli param

   i = 1
   i = i+1 %while i<=length(params) %and charno(params, i)=' '
   %if i<=length(params) %and charno(params, i)='!' %start
      cryptin = 1
      i = i+1
   %finish

   %if i>length(params) %start
      print string("No file names given")
      new line
      %false
   %finish

   source file = ""
   %while i<=length(params) %and charno(params, i)#' ' %c
                            %and charno(params, i)#'/' %cycle
      source file = source file.to string(charno(params, i))
      i = i+1
   %repeat

   updating = 1
   i = i+1 %while i<=length(params) %and (charno(params, i)=' ' %c
                                      %or charno(params, i)='/')
   %if i<=length(params) %and charno(params, i)='!' %start
      updating = 0
      cryptout = 1
      i = i+1
   %finish

   %if i<=length(params) %start
      updating = 0 %unless cryptin=0
      output file = ""
      %while i<=length(params) %and charno(params, i)#' ' %cycle
         output file = output file.to string(charno(params, i))
         i = i+1
      %repeat
   %else
      cryptout = 2 %if cryptin=1 %and cryptout=0
      output file = source file
   %finish
   updating = 0 %if source file#output file

   get password(password) %unless cryptin=0
   open input(1, source file)
   %true
%end

%routine printHelpInfo(%integer ch)
  %integer i

  screen(y)_text_l(i) = ' ' %for i = 1, 1, line size
  cx = 1
  raw out(cr)
  escape('C')
  escape('C')
  escape('C')
  raw out string(help(ch))
  raw out(' ') %for i = length(help(ch))+1, 1, 25
  raw out(cr)
  escape('C')
  escape('C')
  escape('C')
%end

%routine init help info
   %integer i

   help(i) = "Key not recognised" %for i = 0, 1, 127

   help('n') = "repaint screen"
   help(')') = "repaint screen"
   help('H') = "walkabout mode(on/off)"
   help('A') = "Move cursor Up"
   help('B') = "Move cursor Down"
   help('C') = "Move cursor right"
   help('D') = "Move cursor left"
   help('@') = "clear tabs"
   help('y') = "set tab stop"
   help('z') = "back tab"
   help('u') = "delete character"
   help('{') = "delete line"
   help('q') = "erase to end of line"
   help('K') = "recover last EL"
   help('w') = "insert line"
   help('x') = "insert character"
   help('}') = "Enter command  line"
   help('v') = "Abort session"
   help('p') = "move to end of file"
   help('m') = "move to head of file"
   help('s') = "page +"
   help('r') = "page -"
   help('l') = "copy to file"
   help(tab) = "tab to next col/word"
   help(bs) = "recover last deleted line"
   help(lf) = "repeat last find command"
%end

%routine get line(%string(255) pr, %string(255) %name s, %integer echo)
   %integer i, ch
   raw out(charno(pr, i)) %for i = 1, 1, length(pr)
   s = ""
   %cycle
      read symbol(ch)
      %if ch=del %start
         length(s) = length(s)-1 %if length(s)>0
      %else
         print symbol(ch) %unless echo=0
         %exit %if ch=cr
         s = s.to string(ch)
      %finish
   %repeat
%end


%routine write crypt
   %integer i, len, open, cp
   %record(node) %name r
   %integer %array ks(0:31)
   %byte %integer %array a(0:7)

   %routine get password(%string(255) %name p)
      %string(255) q, pr
      %on %event 9 %start
         %stop
      %finish

      pr = to string(bel).to string(esc)."Y".to string(' '+screen size-1). %c
               "  password:".to string(esc)."y"
      %cycle
         get line(pr, p, 0)
         pr = to string(bel).to string(esc)."Y".to string(' '+screen size-1). %c
               "  finger trouble. password:".to string(esc)."y"
         raw out(nl)
         get line(" confirm :".to string(esc)."y", q, 0)
      %repeat %until p=q
   %end

   %routine put symbol(%integer s)
      %integer i

      a(cp) = s
      cp = cp+1
      %if cp>7 %start
         des(a(0), ks(0))
         print symbol(a(i)) %for i = 0, 1, 7
         cp = 0
      %finish
   %end

   %on %event 3 %start
      select output(0)
      raw out(bel)
      escape('Y')
      raw out(' '+screen size-1)
      raw out(' ')
      %if open=0 %start
         escape('y')
         print string(" Cannot open ")
         print string(output file)
      %else
         print string(" Filestore trouble")
      %finish
      print symbol('.')
      new line
      get line(" Alternative file :", output file, 1)
      -> opn
   %finish
   escape('v')
   escape('Y')
   raw out(' '+screen size-3)
   raw out(' ')
   escape('y')
   raw out(nl)
   print string(" Closing edit")
   get password(password) %unless cryptout&1=0
   pw(password, a(0))
   charno(password, i) = 0 %for i = 0, 1, 255
   enkey(a(0), ks(0))

opn:
   cp = 0
   open = 0

   open output(1, output file); ! Event 9 on failure
   select output(1)


   open = 1
   r == head_on
   %while addr(r)#addr(head) %cycle
      len = line size
      len = len-1 %while len>0 %and r_l(len)=' '
      %for i = 1, 1, len %cycle
         put symbol(r_l(i))
         r_l(i) = ' '
      %repeat
      put symbol(nl)
      r == r_on
   %repeat
   a(i) = 0 %for i = cp, 1, 6
   a(7) = cp
   des(a(0), ks(0))
   print symbol(a(i)) %for i = 0, 1, 7
   close output
   select output(0)
%end

%routine clean up
   %integer i, len
   %record(node) %name r

   escape('v')
   r == head_on
   %while addr(r)#addr(head) %cycle
      len = line size
      len = len-1 %while len>0 %and r_l(len)=' '
      r_l(i) = ' ' %for i = 1, 1, len
      r == r_on
   %repeat
%end

%routine write norm
   %integer i, len, ch, open
   %record(node) %name r

   %on %event 3 %start
      select output(0)
      raw out(bel)
      escape('Y')
      raw out(' '+screen size-1)
      raw out(' ')
      %if open=0 %start
         escape('y')
         print string(" Cannot open ")
         print string(output file)
      %else
         print string(" Filestore trouble")
      %finish
      print symbol('.')
      new line
      get line(" Alternative file :", output file, 1)
   %finish
   open = 0

   escape('Y')
   raw out(' '+screen size-3)
   raw out(' ')
   escape('y')
   raw out(nl)
   print string(" Closing edit")
   open output(1, output file); ! Event 9 on failure
   select output(1)

   open = 1
   r == head_on
   %while addr(r)#addr(head) %cycle

      len = line size
      len = len-1 %while len>0 %and r_l(len)=' '
      print symbol(r_l(i)) %for i = 1, 1, len
      new line
      r == r_on
   %repeat
   close output
   select output(0)
%end

%routine write out
   %if cryptout=0 %then write norm %else write crypt
%end

%predicate read crypt
   %integer i, pres symbol, nc, cp, cl
   %record(node) %name n
   %integer %array ks(0:31)
   %byte %integer %array a(0:7)

   %routine get symbol
       %integer i

       %on %event 9 %start
          cl = a(7)&7
       %finish

       %if cp>=cl %start
          %if cl=8 %start
             a(0) = nc
             read symbol(a(i)) %for i = 1, 1, 7
             des(a(0), ks(0))
             cp = 0
             read symbol(nc)
          %else
             %signal 13
          %finish
       %finish
       pres symbol = a(cp)
       cp = cp+1
   %end

   %on %event 3,13 %start
      %if event_event=13 %start
         current == head_on
         current n = 1
         first line = 1
         close input
         select input(0)
         %true
      %else
         raw out(bel)
         print string("File system trouble")
         new line
         %false
      %finish
   %finish

   pw(password, a(0))
   %unless cryptout=2 %start
      charno(password, i) = 0 %for i = 0, 1, 255
   %finish
   dekey(a(0), ks(0))

   select input(1)
   read symbol(nc)
   a(7) = 0
   cp = 8
   cl = 8
   get symbol

   %cycle
      n == new(nil)
      i = 1
      %while i<=line size %and pres symbol#nl %cycle
         n_l(i) = pres symbol
         i = i+1
         get symbol
      %repeat
      n_l(i) = ' ' %and i = i+1 %while i<=line size
      n_on == head
      n_back == current
      head_back == n
      current_on == n
      end line = end line+1
      current == n
      get symbol %if pres symbol=nl
   %repeat
%end

%predicate read norm
   %integer i
   %record(node) %name n
   %on %event 3,9 %start
      %if event_event=9 %start
         current == head_on
         current n = 1
         first line = 1
         close input
         select input(0)
         %true
      %else
         raw out(bel)
         print string("File system trouble")
         new line
         %false
      %finish
   %finish

   select input(1)

   %cycle
      n == new(nil)
      i = 1
      read symbol(n_l(i)) %and i = i+1 %while i<=line size %and next symbol#nl
      n_l(i) = ' ' %and i = i+1 %while i<=line size
      skip symbol
      n_on == head
      n_back == current
      head_back == n
      current_on == n
      end line = end line+1
      current == n
   %repeat
%end

%predicate read in
   %integer i

   head == new(nil)
   head_l(1) = esc
   head_l(2) = 'F'
   head_l(i) = 'd' %for i = 3, 1, 11
   head_l(12) = esc
   head_l(13) = 'G'
   head_l(i) = ' ' %for i = 14, 1, lineSize
   current == head
   head_on == head
   head_back == head

   end line = 0

   %if cryptin=0 %start
      %if read norm %then %true %else %false
   %else
      %if read crypt %then %true %else %false
   %finish
%end

%routine move current(%integer n)

   %if n<current n %start
      current == current_back %for current n = current n-1, -1, n
   %finish %else %if n>current n %start
      current == current_on %for current n = current n+1, 1, n
   %finish
%end

%routine rch(%integer %name ch)

   read symbol(ch)
%end

%routine clear tabs
   %integer i

   tab stop(i) = 0 %for i = 1, 1, line size
   tab stop(1) = 1
   tab stop(lineSize) = 1
%end

%routine initialise
   %integer i
   %const %string(63) def delim = " !""=#$%&()@._';:1234567890-{}+*#()\/|?,^~"
   escape('=')
   pat len = 0
   clear tabs
   tab stop(i) = 1 %for i = 9, 8, line size&(\7)+1

   default(i) = 0 %for i = 0, 1, 127
   default(charno(defdelim, i)) = 1 %for i = 1, 1, length(def delim)
   init help info
   copy number = -1
   top of stack == nil
%end


%routine clear

   escape('v')
   cx = 1
   cy = 1
%end


%routine out(%integer ch)

   cx = cx+1 %if cx<screen columns
   raw out(ch)
%end

%routine move(%integer x, y)
   {x=col, y=line}

   %if (x=cx+1) %and (y=cy) %start
      escape('C')
   %else %if (y=cy+1) %and (x=cx)
       escape('B')
   %else %if (x=cx-1) %and (y=cy)
       escape('D')
   %else %if (y=cy-1) %and (x=cx)
       escape('A')
   %else %if (x#cx) %or (y#cy)
      x = screen columns %if x>screen columns
      escape('Y');
      raw out(31+y)
      raw out(31+x)
   %finish
   cx = x
   cy = y
%end

%routine scroll down

   escape('I')
%end

%routine scroll up

   raw out(lf)
%end

%routine clear line(%integer n)

   move(1, n)
   escape('f')
%end

%routine out line(%integer n, %record(nodedesc) %name nd)
   %integer i, j, max, c

   clear line(n)
   i = nd_ind
   j = i-1
   max = nd_len
   max = screen columns %if max>screen columns
   %while i<=max %cycle
      c = nd_text_l(i)
      %if c=' ' %start
         j = j+1
      %else
         %if j=1 %start
            out(' ')
         %else %if j>0
            move(i, n)
         %finish
         j = 0
         out(c)
      %finish
      i = i+1
   %repeat
%end

%routine redraw
   %integer i, ocx, ocy, n, g

   ocx = cx
   ocy = cy

   n = 2+end line-first line
   n = screen lines %if n>screen lines

   clear

   g = screen p

   %for i = 1, 1, n %cycle
      g = 1 %if g>screen lines
      out line(i, screen(g))
      g = g+1
   %repeat

   move(ocx,ocy)
%end

%routine set ind len(%record(nodedesc) %name n)
   %integer i

   i = 1
   i = i+1 %while n_text_l(i)=' ' %and i<=screen columns
   i = 1 %if i>screen columns
   n_ind = i
   i = line size;
   i = i-1 %while n_text_l(i)=' ' %and i>=2
   i = 0 %if i=1 %and n_text_l(1)=' '
   n_len = i
%end


%routine fetch(%integer n, %record(nodedesc) %name l)

   move current(n)
   l_text == current
   set ind len(l)
%end

%routine change(%integer n, %record(nodedesc) %name l)

   ever changed = 1
%end

%routine insert(%integer n, %record(nodedesc)%name l)
   %record(node) %name r, s
   %integer i

   ever changed = 1 %if in control mode=0
!  get space
!  r == big(big p)
   r == new(nil)

   move current(n)
   s == current_on;
   r_on == s
   r_back == current
   s_back == r
   current_on == r
   end line = end line+1
   l_text == r
   l_ind = 1
   l_len = 0
   l_text_l(i) = ' ' %for i = 1, 1, line size
%end

%routine delete(%integer n)
   %record(node) %name r, s

   ever changed = 1 %if in control mode=0
   move current(n)
   r == current_back
   s == current_on
   r_on == s
   s_back == r
   current_on == top of stack
   current_back == nil
   top of stack == current
   current == s
   end line = end line-1
%end

%integer %function modsl(%integer y)

   y = y+screen lines %while y<1
   y = y-screen lines %while y>screen lines
   %result = y
%end

%routine update

   %unless changed=0 %start
      changed = 0
      set ind len(screen(y))
      indent = screen(y)_ind
      change(first line+cy-1, screen(y))
   %finish
%end

%routine back track(%record(nodedesc) %name l)
   %record(node) %name s, r
   %integer i

   update
   i = modsl(screen p-1)
   %while i#y %cycle
      i = modsl(i-1)
      screen(modsl(i+1)) = screen(i)
   %repeat
   escape('L')
   raw out(cr); ! to keep ttdriver happy
   l_text == top of stack
   l_ind = 0
   l_len = line size
   set ind len(l)

   move current(first line+cy-2)

   s == current_on
   r == top of stack_on
   top of stack_on == s
   top of stack_back == current
   s_back == top of stack
   current_on == top of stack
   top of stack == r
   end line = end line+1
%end

%routine set screen(%integer fl)
   %integer i, l

   l = fl
   i = 1
   %while l<=end line+1 %and i<=screen lines %cycle
      fetch(l, screen(i))
      i = i+1
      l = l+1
   %repeat
   screen p = 1
   first line = fl
%end

%routine obey
   %integer crapped out, ch, ic chars, i, ocx, ocy, fencing
   %record(node)%name temp
   %switch command(0:127)

   %routine fence
      %integer ocx, ocy

      %unless fencing=0 %start
         ocx = cx
         ocy = cy
         fencing = 0
         set ind len(screen(y))
         out line(cy,screen(y)); ! redraw current line to kill bits of fence
         %if cy#screen lines %start
            raw out(cr)
            out line(cy+1, screen(modsl(y+1)))
         %finish
         move(ocx,ocy)
      %finish
   %end

   %routine delete character
      %integer i, ocx, ch

      %if mode=control %start
         raw out(' ')
         raw out(bs)
      %else
         escape('O')
      %finish

      ocx = cx

      screen(y)_text_l(i-1) = screen(y)_text_l(i) %for i = cx+1, 1, line size
      screen(y)_text_l(line size) = ' '
      ch = screen(y)_text_l(screen columns)
      %if ch#' ' %start
         move(screen columns, cy)
         out(ch)
         move(ocx, cy)
      %finish
      changed = 1 %if in control mode=0
   %end

   %routine indent cursor(%integer yy)

      indent = screen(y)_ind
      move(indent, yy)
   %end

   %routine move up(%integer inserting)
      %integer ocx, dumpx

      { line inserted by GS }
      dumpx = cx
      update
      %if cy#screen lines %start
         y = modsl(y+1)
         %if inserting=0 %then indent cursor(cy+1) %else move(1, cy+1)
      %else
         ocx = cx
         scroll up
         fetch(first line+screen lines, screen(screen p))
         %if inserting=0 %then out line(screen lines, screen(screen p)) %else move(1, screen lines)
         y = screen p
         screen p = modsl(screen p+1)
         indent cursor(screen lines) %if inserting=0
         first line = first line+1
      %finish
      ! Line inserted by GS
      move(dumpx, cy) %unless notindenting=0
   %end

   %routine move down
      %integer ocx, dumpx

      { line inserted by GS }
      dumpx = cx
      update
      %if cy#1 %start
         y = modsl(y-1)
         indent cursor(cy-1)
      %else
         ocx = cx
         update
         scroll down
         screen p = modsl(screen p-1)
         fetch(first line-1, screen(screen p))
         out line(1, screen(screen p))
         y = screen p
         indent cursor(1)
         first line = first line-1
      %finish
      { line inserted by GS }
      move(dumpx, cy) %unless notindenting=0
   %end

   %routine append next

      escape('M')
      i = modsl(y+1)
      %while i#screen p %cycle
         screen(modsl(i-1)) = screen(i)
         i = modsl(i+1)
      %repeat
      %if first line+screen size<=end line %start
         i = modsl(screen p-1)
         fetch(first line+screen limit, screen(i))
         out line(screen lines, screen(i))
      %finish
   %end

   %routine delete line
      %integer i, ocy

      ocy = cy
      delete(first line+cy-1)
      append next
      indent cursor(ocy)
   %end

   %routine join
      %integer i, j, mid, ocy
      %record(node)%name prec

      changed = 1
      prec == screen(modsl(y-1))_text
      set ind len(screen(y))
      ocy = cy
      mid = screen(modsl(y-1))_len+1
      i = mid
      j = 1
      %while i<line size %cycle
         prec_l(i) = screen(y)_text_l(j)
         i = i+1
         j = j+1
      %repeat
      set ind len(screen(modsl(y-1)))
      delete(first line+ocy-1)
      temp == top of stack
      top of stack == top of stack_on
      dispose(temp)
      append next
      move down
      out line(ocy-1, screen(y))
      move(mid, ocy-1)
   %end

   %routine blank line
      %integer i, yy

      update
      i = modsl(screen p-1)
      %while i#y %cycle
         i = modsl(i-1)
         screen(modsl(i+1)) = screen(i)
      %repeat
      escape('L')
      raw out(cr); ! to keep ttdriver happy
      insert(first line+cy-2, screen(y))
      cx = 1
   %end

   %routine break
      %integer i, j
      %record(node) n

      j = 1;
      %for i = cx, 1, line size %cycle
         n_l(j) = screen(y)_text_l(i)
         screen(y)_text_l(i) = ' '
         j = j+1;
      %repeat
      n_l(i) = ' ' %for i = j, 1, line size
      escape('K'); ! EL
      set ind len(screen(y))
      move up(1)
      blank line
      screen(y)_text_l(i) = n_l(i) %for i = 1, 1, linesize
      set ind len(screen(y))
      escape('K')
      out line(cy, screen(y))
      move(1, cy)
   %end

   %routine move to(%integer n)
      %integer cl, i

      cl = first line+cy-1
      %if n<first line %or n>first line+screen limit %start
        %if n<cl %start
            %if n<first line-screen lines %start
               set screen(n)
               redraw
            %else
               y = screen p
               move(1, 1)
               move down %while n#first line
            %finish
         %else
            %if n>first line+screen lines+screen limit %start
               i = n-screen limit
               n = 1 %if n<1
               set screen(i)
               redraw
            %else
               move(1, screen lines)
               move up(0) %while firstLine+screen limit#n
            %finish
         %finish
      %finish
      y = modsl(screen p+n-first line)
      move(1, n-first line+1)
   %end

   %predicate locate(%integer %name l, yy)

      %integer ocx, moving
      %record(nodedesc) n
      %predicate match(%integer lo, hi,
                       %record(node) %name m,
                       %integer name yy)
         %integer i, j

         %if (hi-lo)+1>=pat len %start
            %for i = lo, 1, hi-pat len+1 %cycle
               %for j = 1, 1, pat len %cycle
                  ->l1 %if m_l(i+j-1)#pattern(j)
               %repeat
               yy = i
               %true
l1:         %repeat
         %finish
         %false
      %end; ! match

      %unless pat len=0 %start
         ocx = cx+1
         l = first line-1+cy
         moving = 0
         moving = 1 %if backwards#0 %and l>=end line
         %cycle
            %if moving#0 %start
               %if backwards#0 %then l = l-1 %else l = l+1
               %false %if l<=0 %or l>endline
            %finish
            move current(l)
            moving = 1
            n_text == current
            set ind len(n)
            n_ind = ocx %if n_ind<ocx
            ocx = 0
            %true %if match(n_ind, n_len, n_text, yy)
         %repeat
      %else
         %false
      %finish
   %end

   %routine find pattern
      %integer n, yy

      %if locate(n, yy) %start
         %if backwards#0 %start
            %if n>8 %then move to(n-7) %else move to(1)
         %else
            %if n+16<=end line %then move to(n+16) %else move to(end line+1)
         %finish
         move to(n)
         move(yy, cy)
      %else
         raw out(bel)
      %finish
   %end

   %routine interpret line;
      %integer i, n, sign, yy, i ptr

      %routine gch(%integer %name ch)

          %if i ptr=ib lim %start
             ch = cr
          %else
              i ptr = i ptr+1
              ch = ib(i ptr)
          %finish
       %end

      i ptr = 0
      gch(ch)
      %if ch='@' %start
         {pat len = 0; line removed by ghms }
         sign = 0
         gch(ch)
         %if ch='+' %or ch='-' %start
            sign = 1
            sign = -1 %if ch='-'
            gch(ch)
         %finish
         n = 0
         %while '0'<=ch<='9' %cycle
            n = n*10+ch-'0'
            gch(ch)
         %repeat
         i = first line+cy-1
         %if sign<0 %then n = i-n %else %if sign>0 %then n = i+n
         n = 1 %if n<1
         n = endline+1 %if n>end line+1

         gch(ch) %while ch#cr

         %if n>(firstline+cy-1) %start { moving down }
           %if (n+16)>(end line+1) %then move to(end line+1) %else move to(n+16)
         %else { Moving up }
           %if (n-8)<1 %then move to(1) %else move to(n-7)
         %finish

         move to(n)
         move(screen(y)_ind, cy)
      %else %if ch='#'
         ! New mode inserted by GS on 20:2:81
         ! -> or <- on Words delimited by set delimiters
         !  # cr => return to normal
         !  # words => default delimiters
         !  # ( => set of delimiters
         gch(ch)
         %if ch=cr %start
           { normal mode }
           word mode = 0
         %else
            word mode = 1
            gch(ch) %while ch=' ' %and ch#cr
            %if ch='[' %start
               delimiter(i) = 0 %for i = 0, 1, 127
               gch(ch)
               %while ch#']' %and ch#cr %cycle
                  delimiter(ch) = 1
                  gch(ch)
               %repeat
               gch(ch) %while ch#cr
            %else
               gch(ch) %while ch#cr
               delimiter(i) = default(i) %for i = 0, 1, 127
            %finish
         %finish
      %else %if ch#cr
         backwards = 0
         %if ch='+' %or ch='-' %start
            backwards = 1 %if ch='-'
            gch(ch)
         %finish
         %if ch#cr %start
            pat len = 1
            %cycle
               pattern(pat len) = ch
               pat len = pat len+1
               gch(ch)
            %repeat %until ch=cr
            pat len = pat len-1
         %finish
         find pattern
      %finish
   %end

   ! Start of obey
   changed = 0
   ever changed = 0
   crapped out = 0
   fencing = 0
   y = 1
   indent = 1
   mode = normal
   cx = 1
   cy = 1
   %cycle
      rch(ch)
      %if ch=em %or ch=sub %start
         crapped out = 1
         %exit
      %else %if ch=dc4
         exemptmask = 0
         set terminal mode(0)
         *move.l #16_8000,d0
         *trap #0
         exemptmask = -1
         set terminal mode(single+nopage)
         redraw
      %else %if ' '<=ch<='~'
         %if screen(y)_text==head %start
            raw out(ch)
            {attempt to overwrite the fence; insert a line to take it}
            fencing = 1
            screen(modsl(y+1)) = screen(y)
            insert(first line+cy-2, screen(y))
            mode = insert l
         %finish %else %if mode=insert c %start
            escape('i')
            raw out(ch)
            escape('j')
            ic chars = ic chars+1
            screen(y)_text_l(i) = screen(y)_text_l(i-1) %c
               %for i = line size, -1, cx+1
         %else
            raw out(ch)
         %finish
         screen(y)_text_l(cx) = ch
         %if cx<screen columns %start
            cx = cx+1
         %else
            raw out(bel)
            cx = 1
            move(screen columns, cy); ! make sure ttdriver sees
         %finish
         changed = 1 %if in control mode=0
         { next line inserted by GS }
         indent = cx %unless notindenting=0
      %else %if ch=del
         %if cx>=2 %and (mode#insert c %or ic chars>0) %start
            changed = 1 %if in control mode=0
            %if mode=insertC %start
               ic chars = ic chars-1
            %finish
            cx = cx-1
            raw out(bs)
            delete character
         %else %if mode=normal %or (mode=insert c %and icChars>0)
             %if (cy#1 %or first line#1) %and %not screen(y)_text==head %start
                %if mode=insert c %start
                   ic chars = ic chars-1
                %finish
                %if cy=1 %start
                   move down
                   move up(0)
                %finish
                join
             %finish
         %finish
      %else %if ch=tab
         %if mode=control %start
            print help info(tab)
         %else %if cx<screen columns
            i = cx
            %unless word mode=0 %start
               set ind len(screen(y))
               i = i+1 %while i#screen columns %and %c
                        delimiter(screen(y)_text_l(i))=0 %and screen(y)_len>=i
               i = i+1 %while i#screen columns %and %c
                        delimiter(screen(y)_text_l(i))=1 %and screen(y)_len>=i
            %else
               i = i+1 %until i>=screen columns %or tab stop(i)#0
            %finish
            move(i, cy)
         %finish
      %else %if ch=cr
         {changed pmm 22/4/81 so cr enters insert line mode in normal mode}
         %if (mode=insert l %or mode=normal) %and %c
               %not screen(y)_text==head %start
            fence
            mode = insert l
            set ind len(screen(y))
            move up(1)
            blank line
            %unless not indenting=0 %then move(1, cy) %else move(indent, cy)
         %else %if mode=insert c
            break
         %else %if mode=control
            set ind len(screen(y))
            ib(i) = screen(y)_text_l(i) %for i = 1, 1, line size
            iblim = screen(y)_len+1
            ibp = 0
            ib(iblim) = cr
            escape('A'); ! move up to where S thinks the cursor is
            delete line
            delete line
            delete line
!           big p = big p-3
            temp == top of stack
            top of stack == top of stack_on
            dispose(temp)
            temp == top of stack
            top of stack == top of stack_on
            dispose(temp)
            temp == top of stack
            top of stack == top of stack_on
            dispose(temp)
            mode = normal
            %if command line#0 %start
               move to(first line-ocy+1) %if firstLine#1
               command line = 0
            %finish
            move to(line num)
            move(ocx, cy)
            interpret line
            in control mode = 0
         %finish { if mode = control }
      %else %if ch=lf
         fence
         %if mode=control %start
            print help info(lf)
         %else
            mode = normal
            find pattern
         %finish
      %else %if ch=bs
         fence
         %if mode=control %start
            print help info(bs)
         %else %unless top of stack==nil
            mode = normal
            back track(screen(y))
            out line(cy, screen(y))
            move(screen(y)_ind, cy)
         %else
            raw out(bel)
         %finish
      %else %if ch=esc
        fence
        rch(ch);
        %if ch='?' %start
           rch(ch)
           ch = '}' %if ch='M'
           ch = '{' %if ch='t'
           ch = '@' %if ch='v'
        %finish
        %if mode=control %start
           printHelpInfo(ch)
        %else
           set ind len(screen(y)) %if mode=insert l
           mode = normal
           ->command(ch)
command(')'):
command('n'):
           escape('='); { set in pad mode }
           set ind len(screen(y))
           redraw
           ->complete

command('H'):
           notindenting = notindenting!!1
           ->complete

command('A'):
           move down %if (cy#1) %or (first line#1)
           ->complete

command('B'):
           move up(0) %if (cy+first line)#(end line+2)
           ->complete

command('C'):
           move(cx+1, cy) %if cx#screen columns
           ->complete

command('D'):
           move(cx-1, cy) %if cx>1
           ->complete

command('@'):
           clear tabs
           ->complete

command('y'):
           tab stop(cx) = 1
           ->complete

command('z'):
           %if cx>1 %start  { shift tab }
              i = cx
              %if word mode#0 %start
                 set ind len(screen(y))
                 %if delimiter(screen(y)_text_l(i))=0 %start
                    %cycle; ! skip to end of word
                       %exit %if i=screen(y)_ind
                       i = i-1
                    %repeat %until delimiter(screen(y)_text_l(i))#0
                 %finish
                 %cycle; ! skip delimiters
                    %exit %if i=screen(y)_ind
                    i = i-1
                 %repeat %until delimiter(screen(y)_text_l(i))=0
                 %cycle; ! skip to first letter of word
                    %exit %if i=screen(y)_ind
                    %exit %if delimiter(screen(y)_text_l(i-1))#0
                    i = i-1
                 %repeat
              %else
                 i = i-1 %until (i<=1) %or tab stop(i)#0
              %finish
              move(i, cy)
           %finish
           ->complete

command('u'):
           delete character %if addr(screen(y)_text)#addr(head)
           ->complete

command('{'):
           delete line %if addr(screen(y)_text)#addr(head)
           ->complete

command('q'):
           %unless screen(y)_text==head %or lastCommand='q' %start
              ever changed = 1
              copy line(i) = screen(y)_text_l(i) %for i = 1, 1, line size
              copy len = screen(y)_len
              copy pos = cx
              copy number = first line+cy-1
              screen(y)_text_l(i) = ' ' %for i = cx, 1, line size
              escape('x')
              set ind len(screen(y))
           %else
              raw out(bel)
           %finish
           ->complete

command('K'): { recover last El }
           %unless screen(y)_text==head %start
              %if firstline+cy-1=copy number %and copy pos=cx %start
                 %for i = cx, 1, copy len %cycle
                    raw out(copy line(i)) %if i<=screen columns
                    screen(y)_text_l(i) = copy line(i)
                 %repeat
                 set ind len(screen(y))
                 copy number = 1
                 escape('Y'); ! return to original position
                 raw out(31+cy)
                 raw out(31+cx)
              %finish
           %else
              raw out(bel)
           %finish
           ->complete

command('w'):  { Insert Line }
           mode = insert l;
           indent = screen(y)_ind
           blank line
           %unless not indenting=0 %then move(1, cy) %else move(indent, cy)
           ->complete

command('x'): { Insert Character }
           %if %not screen(y)_text==head %start
              mode = insert c
              ic chars = 0
           %finish
           ->complete

command('l'):
           %exit
command('}'):         { Enter }
           lineNum = first line+cy-1
           ocx = cx
           %if line num+2>=end line %and line num+2-end line>screen limit %start
              moveTo(endLine-1)
           %else %if cy>screen size
              %if cy=screen limit %start
                 move to(line num+2)
                 ocy = 2
              %else
                 move to(line num+2)
                 ocy = 3
              %finish
              move to(line num)
              command line = 1
           %finish
           mode = control
           in control mode = 1
           blank line
           blank line
           blank line
           raw out(bel)
           draw box
           ->complete

command('v'): { Abort session }
           crapped out = 1
           %exit

command('p'): { M0  }
           move to(end line+1)
           move to(end line)
           ->complete

command('m'): { M-0 }
           move to(1)
           ->complete

command('s'): { page + }
           %if firstline+screen lines+screen limit>endline %start
              move to(end line+1)
              move to(end line)
           %else
              move to(first line+screen lines+screen limit)
              move to(first line)
           %finish
           ->complete

command('r'): { page - }
           %if firstline>screen lines %start
              move to(first line-screen lines)
           %else
              move to(1)
           %finish
           ->complete
command(*):
           raw out(bel)

complete:
           lastCommand = ch
         %finish
      %finish
   %repeat

   update
   %unless crapped out=0 %start
      updating = 1
      ever changed = 0
   %finish
%end { of obey }


prompt("")
%if initfiles %start
   set terminal mode(single+nopage)
   exemptmask = -1
   initialise
   clear
   %if read in %start
      set screen(1)
      redraw
      obey
      %if ever changed#0 %or updating=0 %start
         write out
      %else %if cryptout#0
         clean up
      %finish
      end message
   %finish
   exemptmask = 0
   set terminal mode(nopage)
%finish
%end %of %program