home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / EDITOR / SFGR.ARK / EDITERR.SPL < prev    next >
Text File  |  1986-10-02  |  4KB  |  203 lines
  1. *    EDITERR.SPL - Edit Error Message (.ERR file-extension)
  2. *            - 64 byte records, zero hex fill at end.
  3. *            - (c) Copyright 1986 - Harris Landsberg.
  4. *            - All rights reserved for commercial use.
  5.  
  6.     * file and variable declarations
  7.  
  8.     file(1,r)
  9.     word(rec)
  10.     byte(chr,err,i,j,pos,col,len)
  11.     byte(line[65],efile[15],comd[128])
  12.  
  13.     * constants definitions
  14.  
  15.     #def(last_pos,63)
  16.     #def(rec_size,64)
  17.  
  18.     * obtain filename from command line
  19.     argl(comd)
  20.     slen(comd,len)
  21.  
  22.     asgn(0,i,j)
  23.     whil(comd[i],eq,' ')
  24.       inrb(i)
  25.     endl()
  26.  
  27.     whil(comd[i],ne,' ')
  28.       cond(comd[i],eq,'.')    extl()
  29.       asgn(comd[i],efile[j])
  30.       cond(i,eq,len)    extl()
  31.       inrb(i,j)
  32.     endl()
  33.     asgn(0,efile[j])
  34.     slen(efile,len)
  35.     cond(len,eq,0)
  36.       jump(filerr)
  37.     cond(len,gt,10)
  38.       jump(filerr)
  39.  
  40.     * Open error file and declare size
  41.     scat('.ERR',efile)
  42.     open(1,efile,'r')
  43.     ferr(err)
  44.     cond(err,gt,0)
  45.     begn()
  46.       pstr('file open error')
  47.       retn()
  48.     endb()
  49.     size(1,@rec_size)
  50.  
  51. $start    * Prompt for record to edit
  52.     vcls()
  53.     pstr('EDITERR - Edit Error Message File (',efile,')')
  54.     load(7,1)
  55.     pstr('Enter 9999 to Exit Program')
  56.     load(4,1)
  57.     pstr('Enter Record #: ')
  58. $getnum    gnum(rec)
  59.     comp(rec,eq,0)
  60.     begn()
  61.       load(4,17)
  62.       loop(5)
  63.         pchr(' ')
  64.       enlp()
  65.       load(4,17)
  66.       jump(getnum)
  67.     endb()
  68.     comp(rec,eq,9999)
  69.       jump(wrapup)
  70.  
  71.     * "rec" contains record # to edit
  72.     read(1,rec,line)
  73.     ferr(err)
  74.     cond(err,gt,0)
  75.     begn()
  76.       forb(i,0,@last_pos)
  77.         asgn(' ',line[i])
  78.       next()
  79.     endb()
  80.     * make control codes to blanks
  81.     forb(i,0,@last_pos)
  82.       cond(line[i],lt,' ')
  83.         asgn(' ',line[i])
  84.     next()
  85.  
  86.     * print out line for editing using SEU type format
  87.     vcls()
  88.     load(4,1)    pstr('Record #: ')    pwrd(rec)
  89.     load(9,15)    asgn('1',chr)
  90.     loop(6)
  91.       pchr(chr)
  92.       loop(9)
  93.         pchr(' ')
  94.       enlp()
  95.       inrb(chr)
  96.     enlp()
  97.     load(10,6)    asgn('1',chr)
  98.     loop(@rec_size)
  99.       pchr(chr)
  100.       cond(chr,ne,'9')
  101.         inrb(chr)
  102.       else()
  103.         asgn('0',chr)
  104.     enlp()
  105.  
  106.     * print the line to be edited
  107.     load(11,6)
  108.     forb(i,0,@last_pos)
  109.       pchr(line[i])
  110.     next()
  111.     * print options
  112.     load(18,16)    pstr('Ctrl D - Delete Character')
  113.     load(19,16)    pstr('Ctrl V - Insert Space')
  114.     load(20,16)    pstr('Ctrl X - Delete to End')
  115.     load(21,16)    pstr('Ctrl Z - Abort Changes')
  116.  
  117.     * prompt for each character starting at position 1
  118.     asgn(0,pos)
  119. $gchr    addb(pos,6,col)
  120.     load(11,col)
  121.     ikey(chr)
  122.     case(chr)
  123.       when(4)    * ctrl d (delete)
  124.         asgn(pos,i)
  125.         whil(i,ne,@last_pos)
  126.           addb(i,1,j)
  127.           asgn(line[j],line[i])
  128.           inrb(i)
  129.         endl()
  130.         asgn(' ',line[@last_pos])
  131.         call(pnext)
  132.       when(22)    * ctrl v (insert)
  133.         cond(line[@last_pos],eq,' ')
  134.         begn()
  135.           asgn(@last_pos,i)
  136.           whil(i,ne,pos)
  137.         subb(i,1,j)
  138.         asgn(line[j],line[i])
  139.         dcrb(i)
  140.           endl()
  141.           asgn(' ',line[pos])
  142.           call(pnext)
  143.         endb()
  144.       when(24)    * ctrl x (delete-to-end)
  145.         forb(i,pos,@last_pos)
  146.           asgn(' ',line[i])
  147.         next()
  148.         call(pnext)
  149.       when(26)    * ctrl z (abort changes)
  150.         jump(start)
  151.       when(8)    * back arrow
  152.         cond(pos,ne,0)
  153.           dcrb(pos)
  154.         else()
  155.           asgn(@last_pos,pos)
  156.         jump(gchr)
  157.       when(12)    * forward arrow
  158.         asgn(line[pos],chr)
  159.         jump(letter)
  160.       when(13)    * ENTER
  161.         jump(write)
  162.       dflt()
  163. $letter        cond(chr,lt,' ')
  164.           jump(gchr)
  165.         pchr(chr)
  166.         asgn(chr,line[pos])
  167.         cond(pos,ne,@last_pos)
  168.           inrb(pos)
  169.         else()
  170.           asgn(0,pos)
  171.     endc()
  172.     jump(gchr)
  173.  
  174. $pnext    * print next of line routine
  175.     forb(i,pos,@last_pos)
  176.       pchr(line[i])
  177.     next()
  178.     retn()
  179.  
  180. $write    * write changes record to file
  181.     asgn(@last_pos,i)
  182.     whil(line[i],eq,' ')
  183.       asgn(0,line[i])
  184.       cond(i,eq,0)    extl()
  185.       dcrb(i)
  186.     endl()
  187.     writ(1,rec,line)
  188.     ferr(err)
  189.     cond(err,eq,0)
  190.       jump(start)
  191.     load(22,1)
  192.     pstr('file write error')
  193.  
  194. $wrapup    * close file and return to CP/M
  195.     load(23,1)
  196.     clos(1)
  197.     retn()
  198.  
  199. $filerr    * invalid or no filename specified
  200.     pstr('invalid filename')
  201.     retn()
  202. 
  203.     re