home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / util / cli / quip / quip.e < prev    next >
Encoding:
Text File  |  1993-08-31  |  53.5 KB  |  1,997 lines
  1. OPT OSVERSION=37,LARGE
  2.  
  3. MODULE 'dos/var', 'utility/tagitem' , 'icon', 'intuition/intuition'
  4. MODULE 'dos/datetime', 'workbench/startup', 'reqtools' , 'dos/dosasl'
  5. MODULE 'dos/dos', 'workbench/workbench', 'dos/rdargs', 'dos/dostags'
  6. MODULE 'libraries/reqtools'
  7.  
  8. ENUM IN_FILE=0, OUT_FILE, LIST_IN_FILE, LIST_OUT_FILE, QUIPDELAY,
  9.      FPREFIX, FSUFFIX, FFORMAT, MIDDLE, FMIDDLE,
  10.      PREFIX, SUFFIX, LIST_PREFIX, LIST_SUFFIX, LIST_SCRIPT, 
  11.      HOWMANY, RANDOM, SERIAL, WHICHQUIP, FORMAT, QRESET, QREQ,
  12.      LIST_FORMAT, MAKETABLE, DISPLAY, MAKE_QUIPS, BADCOMMAND,
  13.      DONOTHING, GOTO, LIST_GOTO, SCRIPT, CHANCE, LIST_CHANCE,
  14.      UPDATE, LIST_ERROR, ERROR, BADCOMWRITE, LIST_RUN, RUN,
  15.      LIST_FSUFFIX, LIST_FPREFIX, LIST_FFORMAT,
  16.      LIST_FMIDDLE, LIST_MIDDLE, FINISHED
  17. ENUM QTAG_INFILENAME=0, QTAG_OUTFILENAME, QTAG_NUMQUIPS,
  18.      QTAG_RANDOM, QTAG_SERIAL, QTAG_RUN, QTAG_FPREFIX, QTAG_FSUFFIX,
  19.      QTAG_PREFIX, QTAG_SUFFIX, QTAG_REQUSE, QTAG_DELAY,
  20.      QTAG_WHICHQUIP, QTAG_FORMAT, QTAG_FFORMAT, QTAG_GENQTABLE,
  21.      QTAG_END, QTAG_DISPLAY, QTAG_VERSION, QTAG_RESET,
  22.      QTAG_UPDATE, QTAG_STDOUT, QTAG_STDERR, QTAG_MIDDLE, QTAG_FMIDDLE
  23. ENUM QERR_BADFILE=1, QERR_BADIFILE, QERR_RUNERR, QERR_FPREFIX,
  24.      QERR_FSUFFIX, QERR_FMIDDLE, QERR_FFORMAT,
  25.      QERR_BADOFILE, QERR_BADTFILE, QERR_BADSFILE
  26. ENUM ARG_VERSION=0, ARG_MOO, ARG_COL, ARG_DATAFILE, ARG_TABLE, ARG_RUN,
  27.      ARG_FFORMAT, ARG_FORMAT, ARG_PRE, ARG_FPRE, ARG_SUF, ARG_FSUF, ARG_WHERE, ARG_RANDOM, 
  28.      ARG_ERROR, ARG_MIDDLE, ARG_FMIDDLE, ARG_STDIO, 
  29.      ARG_REQ, ARG_DELAY, ARG_NUM, ARG_UPDATE, ARG_FILES, ARG_SCRIPT,
  30.      ARG_MAX
  31.      
  32. RAISE "MEM"  IF New()=NIL,        /* set common exceptions:                */
  33.       "MEM"  IF String()=NIL,     /* every call to these functions will be */
  34.       "MEM"  IF List()=NIL,       /* automatically checked against NIL,    */ 
  35.       "^C"   IF CtrlC()=TRUE      /* and the exception "MEM" is raised     */ 
  36.  
  37. DEF efilename=0,estate=0,efile=0  /* nasty nasty global vars.  I hate 'em */
  38.  
  39. /* openerr()
  40.  *
  41.  * This proc opens up an alternative file, appending error messages to it.
  42.  * Just in case really CLEAN quips are wanted.  If no filename is specified,
  43.  * or an error occurs, openerr returns stdout.  It's up to the calling function
  44.  * to close efile (testing that efile isn't stdout first)
  45.  */
  46.  
  47. PROC openerr()
  48.     DEF dt:datetime
  49.     IF efile THEN RETURN
  50.     IF efilename
  51.         DateStamp(dt.stamp)
  52.         dt.format:=FORMAT_DOS /* set datetime options */
  53.         dt.flags:=0
  54.         dt.strday:=String(11)
  55.         dt.strdate:=String(11)
  56.         dt.strtime:=String(11)
  57.         DateToStr(dt)         /* make into string */
  58.         IF efile:=Open(efilename,MODE_READWRITE)
  59.                 Seek(efile,0,OFFSET_END)
  60.         ENDIF
  61.         VfPrintf(efile,'\nQuip: \s | \s | \s\n\n',[dt.strday,dt.strdate,dt.strtime])
  62.         Flush(efile)
  63.     ELSEIF wbmessage                 /* if called from icon */
  64.         WriteF('')
  65.         efile:=stdout
  66.     ELSE
  67.         efile:=Open('CONSOLE:',NEWFILE) /* for stderr activity on CLI call */
  68.     ENDIF
  69.     IF efile=0
  70.         efile:=stdout
  71.     ENDIF
  72. ENDPROC
  73.  
  74. /* fwriteerr()
  75.  *
  76.  * Here's a way to write errors without having to open a window until we
  77.  * absolutely HAVE to.
  78.  */
  79.  
  80. PROC fwriteerr(format,items)
  81.     
  82.     IF efilename=0
  83.         WriteF('')       /* this opens a window for WB users */
  84.     ENDIF
  85.     openerr()         /* make sure stderr is open */
  86.     IF items
  87.         VfPrintf(efile,format,items)
  88.         Flush(efile)
  89.     ELSE
  90.         Fputs(efile,format)
  91.         Flush(efile)
  92.     ENDIF
  93.     IF wbmessage
  94.         estate:=1  /* to set "close window" text in main() */
  95.     ENDIF
  96. ENDPROC
  97.  
  98. /* getprogramicon()
  99.  *
  100.  * This fun little proc is supposed to return a diskobject so you can play
  101.  * with the ToolTypes.  It expects a WBPROJECT icon first, then a WBTOOL
  102.  * icon next.  It locks the icon's directory, unlocking it when it's done.
  103.  * All-in-all, pretty cool.  Mostly based on Term's icon handling, but
  104.  * heavily modified to fit in with my own nefarious purposes (brew ha ha).
  105.  */
  106.  
  107. PROC getprogramicon(wbmessage)
  108.     DEF diskob:PTR TO diskobject,tmp:PTR TO wbarg,newlock,
  109.     wbmsg:PTR TO wbstartup
  110.     diskob:=0; wbmsg:=0
  111.     IF wbmessage
  112.         wbmsg:=wbmessage
  113.         IF tmp:=wbmsg.arglist
  114.             IF tmp.name++
  115.                 newlock:=CurrentDir(tmp.lock)         /* set the current directory to */
  116.                 IF diskob:=GetDiskObjectNew(tmp.name) /* the icon's directory, to read */
  117.                     IF diskob.type<>WBPROJECT            /* the icon's tooltypes. */
  118.                         FreeDiskObject(diskob)
  119.                         diskob:=NIL
  120.                     ENDIF
  121.                 ELSE
  122.                     UnLock(tmp.lock)
  123.                 ENDIF
  124.                 IF diskob=NIL
  125.                         /* Move to the directory the
  126.                          * program was run from.
  127.                          */
  128.                     tmp.name--
  129.                     newlock:=CurrentDir(tmp.lock)
  130.                     IF diskob:=GetDiskObjectNew(tmp.name)
  131.                         IF diskob.type <> WBTOOL
  132.                             FreeDiskObject(diskob)
  133.                             diskob:=NIL
  134.                         ENDIF
  135.                     ELSE
  136.                         UnLock(tmp.lock)
  137.                     ENDIF
  138.  
  139.                     IF diskob=0
  140.                         IF diskob:=GetDiskObjectNew('quip')
  141.                             IF diskob.type<>WBTOOL
  142.                                 FreeDiskObject(diskob)
  143.                                 diskob := NIL
  144.                             ENDIF
  145.                         ENDIF
  146.                     ENDIF
  147.                 ENDIF
  148.             ENDIF
  149.         ENDIF
  150.     ENDIF
  151.  
  152.         /* Still no success. */
  153.  
  154.     IF diskob=0
  155.             /* Use the default names. */
  156.         IF diskob:=GetDiskObjectNew('Quip')
  157.             IF diskob.type<>WBTOOL
  158.                 FreeDiskObject(diskob)
  159.                 diskob := NIL
  160.             ENDIF
  161.         ENDIF
  162.  
  163.         IF diskob=0
  164.             IF diskob:=GetDiskObjectNew('PROGDIR:Quip')
  165.                 IF diskob.type<>WBTOOL
  166.                     FreeDiskObject(diskob)
  167.                     diskob := NIL
  168.                 ENDIF
  169.             ENDIF
  170.         ENDIF
  171.     ENDIF
  172. ENDPROC diskob
  173.  
  174. /* stayrandom()
  175.  *
  176.  * I hate random number generators.  They always need some kind of seed,
  177.  * and generally that seed has to be some gigantic value or something.
  178.  * Because of the way Quip works, if you try to use standard methods for
  179.  * seeding random numbers (read: the clock) you'll wind up with a very
  180.  * non-random set of quips popping up.  Quite ugly.  Especially for BBS
  181.  * sysops.  I figure I can create a four-byte seed value and chuck it in
  182.  * the ENV: directory and nobody would be too concerned.
  183.  */
  184.  
  185. PROC stayrandom()
  186.  
  187.     DEF file,i,ds:datestamp,filename
  188.     
  189.     filename:='ENV:rnd'
  190.     file:=Open(filename,OLDFILE)
  191.     IF file=0
  192.         DateStamp(ds)
  193.         Rnd(-(VbeamPos()*7))
  194.         i:=$A6F87EC1+(VbeamPos()*3)
  195.     ELSE
  196.         Seek(file,0,OFFSET_BEGINNING)
  197.         Fread(file,{i},4,1)
  198.         Close(file)
  199.         Rnd(-(Abs(i)+VbeamPos()))
  200.         i:=RndQ(i)
  201.     ENDIF
  202.     file:=Open(filename,NEWFILE)
  203.     Seek(file,0,OFFSET_BEGINNING)
  204.     Fwrite(file,{i},4,1)
  205.     Close(file)
  206. ENDPROC
  207.  
  208. /* fileend()
  209.  *
  210.  * I wanted a nice, consistent, easy way to handle changing the extention of
  211.  * a filename (eg, quip.dat to quip.tab, etc.).  This is it.
  212.  */
  213.  
  214. PROC fileend(filename,fappend) HANDLE
  215.  
  216.     DEF fname=0,f=0,found=0
  217.  
  218.     WHILE f<>-1
  219.         f:=InStr(filename,'.',fname+1)
  220.         IF f<>-1
  221.             fname:=f
  222.             found:=1
  223.         ENDIF
  224.     ENDWHILE
  225.     IF found=1
  226.         fname := fname + 1
  227.         f:=String(fname+StrLen(fappend))
  228.         StrCopy(f,filename,fname)
  229.         StrAdd(f,fappend,ALL)
  230.     ELSE
  231.         f:=String(StrLen(fappend)+StrLen(filename)+1)
  232.         StrAdd(f,filename,ALL)
  233.         StrAdd(f,'.',ALL)
  234.         StrAdd(f,fappend,ALL)
  235.     ENDIF
  236. EXCEPT
  237.     Raise(exception)
  238. ENDPROC f
  239.  
  240. /* whichquip()
  241.  *
  242.  * This looks in a datafile and figures out which quip Quip is supposed to
  243.  * pick up next.
  244.  */
  245.  
  246. PROC whichquip(filename) HANDLE
  247.  
  248.     DEF file,i,buff[13]:STRING
  249.     
  250.     IF (file := Open(filename,OLDFILE))=0
  251.         Raise(QERR_BADIFILE)
  252.     ENDIF
  253.  
  254.     IF (i := ReadStr(file,buff))=0
  255.         Raise(QERR_BADIFILE)
  256.     ENDIF
  257.     i := Val(buff,0)
  258.     Close (file)
  259.     file:=0
  260.  
  261. EXCEPT
  262.  
  263.     SELECT exception
  264.         CASE QERR_BADIFILE
  265.             i:=IoErr()
  266.             fwriteerr('\n *** Couldn''t get WhichQuip number from datafile.\n',0)
  267.             SetIoErr(i)
  268.     ENDSELECT
  269.  
  270.     IF file THEN Close (file)
  271.     i := 0
  272.  Raise(exception)
  273. ENDPROC i
  274.  
  275. /* bumpquip() 
  276.  *
  277.  * Supposed to change the datafile's internal whichquip number.
  278.  * Just a way to keep the quips serialized.
  279.  */
  280.  
  281. PROC bumpquip(filename,which) HANDLE
  282.     DEF file
  283.     
  284.     IF (file := Open(filename,OLDFILE))=0
  285.         Raise(QERR_BADIFILE)
  286.     ENDIF
  287.  
  288.     IF (VfPrintf(file,'%-12ld',{which}))=-1
  289.         Raise(QERR_BADIFILE)
  290.     ENDIF
  291.     Close (file)
  292.  
  293. EXCEPT
  294.  
  295.     SELECT exception
  296.         CASE QERR_BADIFILE
  297.             IF file THEN Close(file)
  298.             file:=IoErr()
  299.             fwriteerr('\n *** Couldn''t change WhichQuip in "\s".\n',{filename})
  300.             SetIoErr(file)
  301.             file:=0
  302.     ENDSELECT
  303.  
  304.     IF file THEN Close (file)
  305.     Raise(exception)
  306. ENDPROC
  307.  
  308. /* quiptable()
  309.  *
  310.  * Creates a new tablefile from scratch.
  311.  */
  312.  
  313. PROC quiptable(filename) HANDLE
  314.  
  315.     DEF hashname,dfile,hfile,foo,rpos,i=0
  316.     
  317.     hashname := fileend(filename,'tab')
  318.     fwriteerr('\e[0 p\nCreating tablefile "\s".\n              <- Quips in file\b',
  319.         {hashname})
  320.     IF (dfile := Open(filename,OLDFILE))=0
  321.         Raise (QERR_BADIFILE)
  322.     ENDIF
  323.     IF (hfile := Open(hashname,NEWFILE))=0
  324.         Raise(QERR_BADTFILE)
  325.     ENDIF
  326.     i:=i+1
  327.     WHILE foo <> -1
  328.         CtrlC()
  329.         IF (foo:=FgetC(dfile))="@"
  330.             rpos:=Seek(dfile,0,OFFSET_CURRENT)
  331.             Fwrite(hfile,{rpos},4,1)
  332.             fwriteerr('\b\d',{i})
  333.             i:=i+1
  334.         ENDIF
  335.     ENDWHILE
  336.     Close(hfile)
  337.     Close(dfile)
  338.     fwriteerr('\nFinished \s.\e[ p\n\n',{hashname})
  339.  
  340. EXCEPT
  341.     IF hfile THEN Close (hfile)
  342.     IF dfile THEN Close (dfile)
  343.     hfile:=IoErr()
  344.     SELECT exception
  345.         CASE QERR_BADTFILE; fwriteerr('\n\e[ p *** Couldn''t open tablefile.\n',0)
  346.         CASE QERR_BADIFILE; fwriteerr('\n\e[ p *** Datafile won''t open to allow tablefile to be made.\n',0)
  347.     ENDSELECT
  348.     SetIoErr(hfile)
  349.     Raise(exception)
  350. ENDPROC
  351.  
  352. /* delimit()
  353.  *
  354.  * Searches through a datafile and finds a "@" character.  It then returns
  355.  * with the relative position of the character-1, or a -1 if it's at the end
  356.  * of the file.
  357.  */
  358.  
  359. PROC delimit(ifile) HANDLE
  360.  
  361.     DEF k,t
  362.     t:=Seek(ifile,0,OFFSET_CURRENT)
  363.     WHILE k <> -1
  364.         CtrlC()
  365.         k:=FgetC(ifile)
  366.         IF k="@"
  367.             t:=Seek(ifile,0,OFFSET_CURRENT)-1
  368.             RETURN t
  369.         ELSE
  370.             IF k=-1
  371.                 t:=-1
  372.                 RETURN t
  373.             ENDIF
  374.         ENDIF
  375.     ENDWHILE
  376. EXCEPT
  377.     Raise(exception)
  378. ENDPROC
  379.  
  380. /* updatetable()
  381.  *
  382.  * It's really magic.  This helps keep someone from having to sift through
  383.  * all that maketable stuff from scratch.  If given a zero, it'll start from
  384.  * the last known quip in the tablefile, and update the datafile's tablefile
  385.  * to include any new quips that might have been put in there.
  386.  * It can also start from some other place, if someone happened to notice
  387.  * that the quips were warped or something, and wanted a way to re-align
  388.  * them.  Very nice.. very new (tried to put this in my old Quip program
  389.  * but had trouble... much more luck this time).
  390.  */
  391.  
  392. PROC updatetable(ifilename,num) HANDLE
  393.     DEF tfile=0,ifile=0,size,rpos,i,tfilename=0,hold=0
  394.     
  395.     tfilename:=fileend(ifilename,'tab')
  396.     size:=FileLength(tfilename)
  397.     IF size=-1 THEN Raise(QERR_BADTFILE)
  398.     i:=Div(size,4)
  399.     IF (i<num) OR (num=0)
  400.         num:=i
  401.     ENDIF
  402.     hold:=New((num*4)+1)
  403.     tfile:=Open(tfilename,OLDFILE)
  404.     IF tfile=0 THEN Raise(QERR_BADTFILE)
  405.     Seek(tfile,0,OFFSET_BEGINNING)
  406.     Fread(tfile,hold,num*4,1)
  407.     Close(tfile)
  408.     tfile:=Open(tfilename,NEWFILE)
  409.     IF tfile=0 THEN Raise(QERR_BADTFILE)
  410.     Fwrite(tfile,hold,num*4,1)
  411.     Seek(tfile,-4,OFFSET_CURRENT)
  412.     Fread(tfile,{rpos},4,1)
  413.     ifile:=Open(ifilename,OLDFILE)
  414.     IF ifile=0 THEN Raise(QERR_BADIFILE)
  415.     Seek(ifile,rpos+1,OFFSET_BEGINNING)
  416.     fwriteerr('\e[0 pUpdating \s:\n\d              <- Quips in file\b',[tfilename,num])
  417.     LOOP
  418.         CtrlC()
  419.         rpos:=delimit(ifile)
  420.         IF rpos=-1 THEN Raise("OK")
  421.         rpos:=rpos+1
  422.         num:=num+1
  423.         fwriteerr('\d\b',{num})
  424.         Fwrite(tfile,{rpos},4,1)
  425.         Seek(ifile,2,OFFSET_CURRENT)
  426.     ENDLOOP
  427. EXCEPT
  428.     IF ifile THEN Close(ifile)
  429.     IF tfile THEN Close(tfile)
  430.     IF hold THEN Dispose(hold)
  431.     IF tfilename THEN Dispose(tfilename)
  432.     ifile:=IoErr()
  433.     SELECT exception
  434.         CASE "OK"
  435.             fwriteerr('\n\e[ pFinished.\n\n',0)
  436.             RETURN
  437.         CASE "^C"
  438.         DEFAULT
  439.             fwriteerr('\n¡Error while updating tablefile:',0)
  440.     ENDSELECT
  441.     fwriteerr('\n\e[ p',0)
  442.     SetIoErr(ifile)
  443.     Raise(exception)
  444. ENDPROC
  445.  
  446. /* textfileget()
  447.  *
  448.  * This gets the text within a file and puts it in a string.
  449.  */
  450.  
  451. PROC textfileget(filename) HANDLE
  452.     DEF file,text=0,i
  453.     
  454.     i:=FileLength(filename)
  455.     file:=Open(filename,OLDFILE)
  456.     IF file=0 THEN RETURN 0
  457.     text:=String(i+1)
  458.     IF Fread(file,text,i,1)<1
  459.         Close(file)
  460.         Dispose(text)
  461.         RETURN 0
  462.     ENDIF
  463.     Close(file)
  464. EXCEPT
  465.     Raise(exception)
  466. ENDPROC text
  467.  
  468. /* findquip()
  469.  *
  470.  * This is a biggie...
  471.  * This proc processes the tags given to it, handling various settings and
  472.  * stuff (much like QuipScript, except with much fewer options <grin>).
  473.  * This is the routine that actually FINDS the various quips.  It takes all
  474.  * the other procedures above and USES them to its advantage.  This process
  475.  * will eat your brain.
  476.  */
  477.  
  478. PROC findquip(tags) HANDLE
  479.  
  480.     DEF ofile=0,rnd=0,h,i,j,k,pre=0,suf=0,howmany=1,ofilename=0,ifilename,
  481.     tagnum,qprompt=0,whichq=0,tfile=0,rndmax,squip,equip,quip,num[13]:STRING,
  482.     display=0,programmer,version,ifile=0,reqtags,requse=0,dornd=0,
  483.     hinfo:PTR TO rthandlerinfo,waitval=900000,runcom=0,middle=0
  484.  
  485.     programmer:='jvanriper@uncavx.unca.edu' /* set the programmer */
  486.     version:='$VER: Quip 0.705 (1.9.93)'
  487.     ifilename:='S:Quip.dat'
  488.     /* A VERSION string!  And to proper standards! Sorta..*/
  489.     
  490.     /* Now we're ready to process the tags...*/
  491.     FOR i:=0 TO ListLen(tags)-1
  492.         CtrlC()
  493.         tagnum:=ListItem(tags,i)
  494.         SELECT tagnum
  495.  
  496.         CASE QTAG_REQUSE /* if tag says we want to use reqtool.library...*/
  497.             requse:=1
  498.  
  499.         CASE QTAG_INFILENAME /* What filename are we getting quips from? */
  500.             i:=i+1
  501.             ifilename:=ListItem(tags,i)
  502.         
  503.         CASE QTAG_RESET /* re-initialize all the data to default values */
  504.             rnd:=0
  505.             dornd:=0
  506.             display:=0
  507.             rndmax:=0
  508.             howmany:=1
  509.             ofilename:=0
  510.             IF qprompt THEN Dispose(qprompt)
  511.             qprompt:=0
  512.             ifilename:=0
  513.             IF pre THEN Dispose(pre)
  514.             IF suf THEN Dispose(suf)
  515.             pre:=0; suf:=0
  516.             tfile:=0
  517.             ofilename:=0
  518.             ifilename:='S:Quip.dat'
  519.             whichq:=0
  520.             IF ifile THEN Close(ifile)
  521.             IF ofile THEN Close(ofile)
  522.             ifile:=0
  523.             ofile:=0
  524.             IF tfile THEN Close(tfile)
  525.             tfile:=0
  526.             requse:=0
  527.             waitval:=900000
  528.             runcom:=0
  529.             IF middle THEN Dispose(middle)
  530.  
  531.         CASE QTAG_OUTFILENAME /* If tags says we have to make files...*/
  532.             i:=i+1
  533.             ofilename:=ListItem(tags,i)
  534.  
  535.         CASE QTAG_RUN
  536.             i:=i+1
  537.             runcom:=ListItem(tags,i)
  538.             runcom:=addstrings(runcom,' env:quip.tmp')
  539.  
  540.         CASE QTAG_DELAY /* Sets the delay count for reqtools.library, and says requesters are needed */
  541.             i:=i+1
  542.             waitval:=ListItem(tags,i)
  543.             requse:=1
  544.  
  545.         CASE QTAG_NUMQUIPS /* How many quips do we want? */
  546.             i:=i+1
  547.             howmany:=ListItem(tags,i)
  548.  
  549.         CASE QTAG_RANDOM /* Are we doing random quips?  If so, do we have tablefile? */
  550.             dornd:=1
  551.             rndmax:=Div(FileLength(fileend(ifilename,'tab')),4)-1
  552.             IF rndmax<0
  553.                 rndmax:=0
  554.                 rnd:=FileLength(ifilename)
  555.             ELSE
  556.                 rnd:=Rnd(rndmax)+1
  557.             ENDIF
  558.  
  559.         CASE QTAG_SERIAL /* Ixnay on the Andomray....*/
  560.             rnd:=0
  561.             rndmax:=0
  562.  
  563.         CASE QTAG_PREFIX /* We want a prefix */
  564.             i:=i+1
  565.             pre:=modformat(ListItem(tags,i))
  566.  
  567.         CASE QTAG_FPREFIX /* Get prefix from file */
  568.             i:=i+1
  569.             IF pre THEN Dispose(pre)
  570.             pre:=textfileget(ListItem(tags,i))
  571.             IF pre
  572.                 pre:=modformat(pre)
  573.             ELSE
  574.                 pre:=IoErr()
  575.                 fwriteerr('¡Bad prefix file: "\s"!\n',[ListItem(tags,i)])
  576.                 SetIoErr(pre)
  577.                 pre:=0
  578.                 Raise(QERR_FPREFIX)
  579.             ENDIF
  580.  
  581.         CASE QTAG_MIDDLE /* We want to stuff junk between numbered quips */
  582.             i:=i+1
  583.             middle:=modformat(ListItem(tags,i))
  584.  
  585.         CASE QTAG_FMIDDLE /* Get middle from file */
  586.             i:=i+1
  587.             IF middle THEN Dispose(middle)
  588.             middle:=textfileget(ListItem(tags,i))
  589.             IF middle
  590.                 middle:=modformat(middle)
  591.             ELSE
  592.                 middle:=IoErr()
  593.                 fwriteerr('¡Bad middle file: "\s"!\n',[ListItem(tags,i)])
  594.                 SetIoErr(middle)
  595.                 middle:=0
  596.                 Raise(QERR_FMIDDLE)
  597.             ENDIF
  598.  
  599.         CASE QTAG_STDOUT
  600.             i:=i+1
  601.             WriteF(ListItem(tags,i))
  602.             Dispose(ListItem(tags,i))
  603.  
  604.         CASE QTAG_STDERR
  605.             i:=i+1
  606.             fwriteerr(ListItem(tags,i),0)
  607.             Dispose(ListItem(tags,i))
  608.  
  609.         CASE QTAG_SUFFIX /* We want a suffix file */
  610.             i:=i+1
  611.             suf:=modformat(ListItem(tags,i))
  612.  
  613.         CASE QTAG_FSUFFIX /* Get suffix from file */
  614.             i:=i+1
  615.             IF suf THEN Dispose(suf)
  616.             suf:=textfileget(ListItem(tags,i))
  617.             IF suf
  618.                 suf:=modformat(suf)
  619.             ELSE
  620.                 suf:=IoErr()
  621.                 fwriteerr('¡Bad suffix file: "\s"!\n',[ListItem(tags,i)])
  622.                 SetIoErr(suf)
  623.                 suf:=0
  624.                 Raise(QERR_FSUFFIX)
  625.             ENDIF
  626.  
  627.         CASE QTAG_UPDATE /* We want to update our tablefile */
  628.             i:=i+1
  629.             updatetable(ifilename,ListItem(tags,i))
  630.  
  631.         CASE QTAG_WHICHQUIP /* Which quip do we want to start from? */
  632.             i:=i+1
  633.             whichq:=ListItem(tags,i)
  634.  
  635.         CASE QTAG_FFORMAT /* Get format from file */
  636.             i:=i+1
  637.             qprompt:=textfileget(ListItem(tags,i))
  638.             IF qprompt
  639.                 qprompt:=modformat(qprompt)
  640.             ELSE
  641.                 qprompt:=IoErr()
  642.                 fwriteerr('¡Bad format file: "\s"!\n',[ListItem(tags,i)])
  643.                 SetIoErr(qprompt)
  644.                 qprompt:=0
  645.                 Raise(QERR_FFORMAT)
  646.             ENDIF
  647.  
  648.  
  649.         CASE QTAG_FORMAT /* The quip will be preceded with some formatted stuff */
  650.             i:=i+1
  651.             qprompt:=modformat(ListItem(tags,i))
  652.  
  653.         CASE QTAG_GENQTABLE /* make a tablefile from scratch */
  654.             quiptable(ifilename)
  655.  
  656.         CASE QTAG_END /* The monster.  Now we must make quips.*/
  657.             IF (dornd=0) AND (whichq=0) THEN whichq:=whichquip(ifilename)
  658.             /* If we aren't doing this randomly, and we haven't picked a quip,
  659.              * we need to decide which quip we want to show.
  660.              */
  661.             IF howmany=0 THEN howmany:=1 /* just in case...*/
  662.             tfile:=Open(fileend(ifilename,'tab'),OLDFILE)
  663.             IF tfile<>0 /* we have tablefile.. now let's get the rpos of a quip! */
  664.                 IF (dornd) AND (whichq=0)  /* make sure random stuff works on first one */
  665.                     whichq:=Rnd(rndmax)+1
  666.                 ENDIF
  667.                 IF Div(FileLength(fileend(ifilename,'tab')),4)<(whichq)
  668.                     whichq:=Div(FileLength(fileend(ifilename,'tab')),4)
  669.                 ENDIF
  670.                 Seek(tfile,(whichq-1)*4,OFFSET_BEGINNING)
  671.                 Fread(tfile,{squip},4,1)
  672.                 Seek(tfile,0,OFFSET_BEGINNING)
  673.             ELSEIF (dornd) AND (whichq=0) /* no tablefile, random. */
  674.                 k:=-1
  675.                 ifile:=Open(ifilename,OLDFILE)
  676.                 IF ifile=0 THEN Raise(QERR_BADIFILE)
  677.                 WHILE k=-1
  678.                     CtrlC()
  679.                     Seek(ifile,Rnd(FileLength(ifilename)),OFFSET_BEGINNING)
  680.                     k:=delimit(ifile)
  681.                 ENDWHILE
  682.                     squip:=k+1
  683.                     Seek(ifile,2,OFFSET_CURRENT)
  684.             ELSE                            /* no tablefile, and serial... phew */
  685.                 ifile:=Open(ifilename,MODE_OLDFILE)
  686.                 fwriteerr('\e[0 pFound Quip #:\n',0) /* turn off the cursor */
  687.                 FOR j:=1 TO whichq
  688.                     CtrlC()
  689.                     k:=delimit(ifile)
  690.                     IF k<>-1
  691.                         fwriteerr('\d\b',{j})
  692.                         squip:=k+1
  693.                     ELSE
  694.                         j:=whichq
  695.                         whichq:=1
  696.                         Seek(ifile,0,OFFSET_BEGINNING)
  697.                         k:=delimit(ifile)
  698.                         IF k<>-1
  699.                             fwriteerr('1\b',0)
  700.                             squip:=k+1
  701.                         ELSE
  702.                             Raise(QERR_BADIFILE)
  703.                         ENDIF
  704.                     ENDIF
  705.                 ENDFOR
  706.                 fwriteerr('\e[ p\n',0) /* turn on the cursor */
  707.             ENDIF
  708.             IF ifile=0  /* If, after all the above, we somehow managed to get away
  709.                            without opening the incoming file...*/
  710.                 ifile:=Open(ifilename,MODE_OLDFILE)
  711.                 IF ifile=0 THEN Raise(QERR_BADIFILE)
  712.                 Seek(ifile,squip+1,OFFSET_BEGINNING)
  713.             ENDIF
  714.             equip:=delimit(ifile) /* we've already found the start, where's the end?*/
  715.             FOR j:=1 TO howmany   /* Now we process quips until NUM is satisfied. */
  716.                 CtrlC()
  717.                 IF equip=-1 THEN equip:=FileLength(ifilename) /* the end goes to EOF, so..*/
  718.                 quip:=New(equip-squip+1)
  719.                 Seek(ifile,squip,OFFSET_BEGINNING) /*find quip..*/
  720.                 h:=Fread(ifile,quip,equip-squip,1) /*get quip..*/
  721.                 IF h<1 THEN Raise(QERR_BADIFILE)
  722.                 IF ofilename                    /* if writing to files...*/
  723.                     StringF(num,'\d',j-1)
  724.                     IF (ofile:=Open(fileend(ofilename,num),NEWFILE))=0
  725.                         Raise (QERR_BADOFILE)
  726.                     ENDIF
  727.                     IF pre<>0 THEN Fputs(ofile,pre)
  728.                     IF qprompt<>0 THEN VfPrintf(ofile,qprompt,{whichq})
  729.                     Fputs(ofile,quip)
  730.                     IF suf<>0 THEN Fputs(ofile,suf)
  731.                     Close(ofile)
  732.                     ofile:=0
  733.                 ENDIF
  734.                 IF runcom                          /* if we're running a command.. */
  735.                     requse:=0
  736.                     IF pre THEN requse:=addstrings(requse,pre)
  737.                     IF qprompt
  738.                         h:=String(StrLen(qprompt)+13)
  739.                         StringF(h,qprompt,whichq)
  740.                         requse:=addstrings(requse,h)
  741.                         Dispose(h)
  742.                     ENDIF
  743.                     requse:=addstrings(requse,quip)
  744.                     IF suf THEN requse:=addstrings(requse,suf)
  745.                     ofile:=Open('env:quip.tmp',NEWFILE)
  746.                     IF ofile
  747.                         Fputs(ofile,requse)
  748.                         Close(ofile)
  749.                         Dispose(requse)
  750.                         ofile:=0
  751.                         requse:=0
  752.                         IF wbmessage
  753.                             requse:=Open('CON:',NEWFILE)
  754.                             ofile:=SystemTagList(runcom,[SYS_INPUT,requse,SYS_OUTPUT,requse])
  755.                             Close(requse)
  756.                             requse:=0
  757.                         ELSE
  758.                             ofile:=SystemTagList(runcom,[SYS_USERSHELL])
  759.                         ENDIF
  760.                         DeleteFile('env:quip.tmp')
  761.                         IF ofile
  762.                             ofile:=0
  763.                             Raise(QERR_RUNERR)
  764.                         ENDIF
  765.                         requse:=0
  766.                     ELSE
  767.                         fwriteerr('Quip: unable to open tmp file\n',0)
  768.                     ENDIF
  769.                 ELSEIF (display AND (requse=0)) OR ((ofilename=0) AND (requse=0))
  770.                     IF pre<>0 THEN WriteF(pre); Flush(stdout)
  771.                     IF qprompt<>0 THEN WriteF(qprompt,whichq); Flush(stdout)
  772.                     WriteF(quip)
  773.                     IF suf<>0 THEN WriteF(suf)
  774.                 ELSEIF requse AND (ofilename=0)   /* well, maybe requesters, then*/
  775.                     requse:=0                             /* we're going to use requse for stuff*/
  776.                     requse:=addstrings(requse,pre) /* here we have to put the quip*/
  777.                     requse:=addstrings(requse,quip)
  778.                     requse:=addstrings(requse,suf) /* in one string..*/
  779.                     IF qprompt
  780.                         h:=String(StrLen(qprompt)+13)
  781.                         StringF(h,qprompt,whichq)
  782.                     ELSE
  783.                         h:='Quip'
  784.                     ENDIF
  785.                     reqtoolsbase:=OpenLibrary('reqtools.library',0) /* opening library */
  786.                     IF reqtoolsbase          /* Note: putting FORMAT in title of requester*/
  787.                         reqtags:=[RTEZ_REQTITLE,h,RT_REQHANDLER,{hinfo},TAG_DONE]
  788.                         /* reqtools.library stuff... needed for asynchronous info-reqs */
  789.                         ofile:=requse
  790.                         requse:=RtEZRequestA(ofile,'Ok',0,0,reqtags) /* asynch reqs*/
  791.                         IF requse=CALL_HANDLER                             /* so, CALL_H.*/
  792.                             k:=0
  793.                             WHILE (requse=CALL_HANDLER)
  794.                                 Delay(5)                                         /*1/10th second*/
  795.                                 requse:=RtReqHandlerA(hinfo,i,[TAG_DONE])
  796.                                 IF k++=waitval                                   /*done yet?*/
  797.                                     requse:=RtReqHandlerA(hinfo,i,[RTRH_ENDREQUEST,TAG_DONE])
  798.                                     IF StrCmp(h,'Quip',ALL)=FALSE   /* Dispose of FORMAT (be neat) */
  799.                                         Dispose(h)
  800.                                     ENDIF
  801.                                 ENDIF
  802.                             ENDWHILE
  803.                         ELSE
  804.                             fwriteerr('Couldn''t asynchronously open reqtools.library.\n\n',0)
  805.                             WriteF(ofilename)
  806.                         ENDIF
  807.                         CloseLibrary(reqtoolsbase)
  808.                     ELSE
  809.                         fwriteerr('Couldn''t open reqtools.library.\n',0)
  810.                     ENDIF
  811.                     requse:=1                        /* since we used requse, we must reset it*/
  812.                     Dispose(ofile)                   /* more cleanup*/
  813.                     ofile:=0
  814.                 ENDIF
  815.                 Dispose(quip)               /* now we must find next quip */
  816.                 quip:=0
  817.                 IF middle AND (j<>howmany)  /* oh yeah.  We need to write the middle */
  818.                     WriteF('\s',middle)
  819.                 ENDIF
  820.                 IF (dornd) AND (tfile)/* if we're random with tablefiles..*/
  821.                     whichq:=Rnd(rndmax)+1
  822.                     Seek(tfile,(whichq-1)*4,OFFSET_BEGINNING)
  823.                     Fread(tfile,{squip},4,1)
  824.                     Seek(ifile,squip,OFFSET_BEGINNING)
  825.                 ELSEIF (dornd) AND (tfile=0) /* random, but no tablefiles... */
  826.                     k:=-1
  827.                     whichq:=0                   /* Nullify whichq, since it has no purpose*/
  828.                     WHILE k=-1
  829.                         CtrlC()
  830.                         Seek(ifile,Rnd(FileLength(ifilename)),OFFSET_BEGINNING)
  831.                         k:=delimit(ifile)
  832.                     ENDWHILE
  833.                     squip:=k+1
  834.                 ELSE
  835.                     squip:=equip+1
  836.                     whichq:=whichq+1
  837.                     IF squip>=FileLength(ifilename)
  838.                         Seek(ifile,0,OFFSET_BEGINNING)
  839.                         squip:=delimit(ifile)
  840.                         whichq:=1
  841.                     ENDIF
  842.                     equip:=delimit(ifile)
  843.                 ENDIF                           /* now let's find end of quip */
  844.                 equip:=delimit(ifile)
  845.             ENDFOR                           /* process next quip, or quit */
  846.             IF quip <> 0                     /* QTAG_END is finished.. need to cleanup*/
  847.                 Dispose(quip)
  848.                 quip:=0
  849.             ENDIF
  850.             IF ifile <> 0
  851.                 Close(ifile)
  852.                 ifile:=0
  853.             ENDIF
  854.             IF tfile <> 0
  855.                 Close(tfile)
  856.                 tfile:=0
  857.             ENDIF
  858.             IF ofile <> 0
  859.                 Close(ofile)
  860.                 ofile:=0
  861.             ENDIF
  862.             IF dornd=0      /* if serially handling quips, update whichquip count */
  863.                 bumpquip(ifilename,whichq)
  864.             ENDIF
  865.  
  866.         CASE QTAG_DISPLAY /* quips are to be displayed */
  867.             display:=1
  868.  
  869.         CASE QTAG_VERSION /* show the version string */
  870.             WriteF('\n')
  871.             WriteF(version)
  872.             WriteF('\n')
  873.  
  874.         DEFAULT           /* this should never happen, but if you make a mistake..*/
  875.             IF ifile THEN Close(ifile)
  876.             ifile:=ListItem(tags,i)
  877.             fwriteerr('\n¡Internal Error: findquip()!\n',0)
  878.             ifile:=0
  879.  
  880.         ENDSELECT
  881.     ENDFOR
  882.  
  883. EXCEPT          /* errors? */
  884.     IF ifile THEN Close(ifile)
  885.     IF ofile THEN Close(ofile)
  886.     IF tfile THEN Close(tfile)
  887.     IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  888.     ifile:=IoErr()
  889.     SELECT exception
  890.         CASE QERR_BADIFILE
  891.             fwriteerr('\nBad datafile: "\s"\n',{ifilename})
  892.         CASE QERR_BADTFILE
  893.             ofile:=fileend(ifilename,'tab')
  894.             fwriteerr('\nBad tablefile: "\s"\n',{ofile})
  895.         CASE QERR_BADOFILE
  896.             fwriteerr('\nBad outfile: "\s"\n', {ofilename})
  897.         CASE QERR_RUNERR
  898.             fwriteerr('\nCommand returned with error: "\s"\n',{runcom})
  899.     ENDSELECT
  900.     SetIoErr(ifile)
  901.     Raise(exception)
  902. ENDPROC
  903.  
  904. /* updatetags()
  905.  *
  906.  * This proc adds new items to a list.
  907.  */
  908.  
  909. PROC updatetags(tag,it) HANDLE
  910.     DEF tmp=0
  911.     IF tag<>0
  912.         tmp:=List(ListLen(tag)+ListLen(it)+1)
  913.         ListAdd(tmp,tag,ALL)
  914.         DisposeLink(tag)
  915.     ELSE
  916.         tmp:=List(ListLen(it))
  917.     ENDIF
  918.     ListAdd(tmp,it,ALL)
  919. EXCEPT
  920.     Raise(exception)
  921. ENDPROC tmp
  922.  
  923. /* addstrings()
  924.  *
  925.  * This allows the second string to be added to the end of another string
  926.  * without worrying about memory problems and truncation.
  927.  */
  928.  
  929. PROC addstrings(a,b) HANDLE
  930.     DEF tmp=0
  931.     
  932.     IF a                                  /* talk about anal retention...*/
  933.         IF b
  934.             tmp:=String(StrLen(a)+StrLen(b))
  935.         ELSE
  936.             tmp:=String(StrLen(a))
  937.         ENDIF
  938.     ELSEIF b
  939.         tmp:=String(StrLen(b))
  940.     ENDIF
  941.     IF a
  942.         StrAdd(tmp,a,ALL)
  943.         Dispose(a)
  944.     ENDIF
  945.     IF b
  946.         StrAdd(tmp,b,ALL)
  947.     ENDIF
  948.     RETURN tmp
  949.  
  950. EXCEPT
  951.     Raise(exception)
  952. ENDPROC tmp
  953.  
  954. /* addchar()
  955.  *
  956.  * This really sucks... I had to create some way to add a character to the
  957.  * end of a string.  This should do it (I hope).
  958.  */
  959.  
  960. PROC addchar(line,in)
  961.     DEF tmp=0,i
  962.  
  963.     IF in
  964.         tmp:=String(StrLen(line)+2)
  965.         StrAdd(tmp,line,ALL)
  966.         i:=StrLen(tmp)
  967.         tmp[i]:=in
  968.         SetStr(tmp,i+20)
  969.         Dispose(line)
  970.         RETURN tmp
  971.     ELSE
  972.         tmp:=line
  973.     ENDIF
  974. ENDPROC tmp
  975.  
  976. /* modformat()
  977.  *
  978.  * This does some simple formatting for pre/suf/format texts.  Actually,
  979.  * the formatting isn't all THAT simple, as it allows for environment
  980.  * variables, time and date insertion, and other stuff.  Really nice.
  981.  * I need to make it handle larger texts, though.  Limited to about 200
  982.  * chars.
  983.  */
  984.  
  985. PROC modformat(line) HANDLE
  986.     DEF i,j,k,c,tmp,dt:datetime,ch,st
  987.  
  988.     tmp:=String(StrLen(line))
  989.     FOR i:=0 TO StrLen(line)
  990.         CtrlC()
  991.         ch:=line[i]
  992.         SELECT ch
  993.             CASE "{" /* if we have a {} construct...*/
  994.                 DateStamp(dt.stamp)   /* get the date/time */
  995.                 dt.format:=FORMAT_DOS /* set datetime options */
  996.                 dt.flags:=0
  997.                 dt.strday:=String(11)
  998.                 dt.strdate:=String(11)
  999.                 dt.strtime:=String(11)
  1000.                 DateToStr(dt)         /* make into string */
  1001.                 st:=String(StrLen(tmp))
  1002.                 c:=String(81)
  1003.                 st:=addstrings(st,tmp)
  1004.                 j:=i+1
  1005.                 k:=InStr(line,'}',j)  /* can we find a '}' character?*/
  1006.                 IF k=-1               /* nope.. best use EOS (sorta) */
  1007.                     k:=StrLen(line)-1
  1008.                 ENDIF
  1009.                 MidStr(c,line,j,k-j)
  1010.                 i:=i+StrLen(c)+1
  1011.                 j:=StrLen(tmp)
  1012.                 IF StrCmp(c,'day',ALL)  /* determining {} value */
  1013.                     addstrings(st,dt.strday)
  1014.                 ELSEIF StrCmp(c,'date',ALL)
  1015.                     st:=addstrings(st,dt.strdate)
  1016.                 ELSEIF StrCmp(c,'idate',ALL)
  1017.                     dt.format:=FORMAT_INT
  1018.                     DateToStr(dt)
  1019.                     st:=addstrings(st,dt.strdate)
  1020.                 ELSEIF StrCmp(c,'adate',ALL)
  1021.                     dt.format:=FORMAT_USA
  1022.                     DateToStr(dt)
  1023.                     st:=addstrings(st,dt.strdate)
  1024.                 ELSEIF StrCmp(c,'cdate',ALL)
  1025.                     dt.format:=FORMAT_CDN
  1026.                     DateToStr(dt)
  1027.                     st:=addstrings(st,dt.strdate)
  1028.                 ELSEIF StrCmp(c,'time',ALL)
  1029.                     st:=addstrings(st,dt.strtime)
  1030.                 ELSEIF StrCmp(c,'quip',ALL)
  1031.                     st:=addstrings(st,'\d')
  1032.                 ELSEIF StrCmp(c,'{',ALL)
  1033.                     st:=addstrings(st,'{')
  1034.                 ELSE   /* none of the special formats, so it's maybe environment variable*/
  1035.                         j:=String(81)
  1036.                         k:=GetVar(c,j,80,0)
  1037.                         IF k<>-1      /* environment variable? */
  1038.                             k:=IoErr()
  1039.                             Dispose(j)
  1040.                             j:=String(k)
  1041.                             GetVar(c,j,k+1,0)
  1042.                             st:=addstrings(st,j)
  1043.                             Dispose(j)
  1044.                         ELSE          /* nope */
  1045.                             fwriteerr('\nEnvironment variable "\s" not defined.\n',{c})
  1046.                             Dispose(j)
  1047.                     ENDIF
  1048.                 ENDIF
  1049.                 Dispose(tmp)
  1050.                 tmp:=st
  1051.             CASE "\"  /* maybe it's a formatting character */
  1052.                 i:=i+1
  1053.                 j:=line[i]
  1054.                 SELECT j       /* choose the formatting character..*/
  1055.                     CASE "\"
  1056.                         tmp:=addchar(tmp,"\")
  1057.                     CASE "r"
  1058.                         tmp:=addchar(tmp,13)
  1059.                     CASE "n"
  1060.                         tmp:=addchar(tmp,10)
  1061.                     CASE "e"
  1062.                         tmp:=addchar(tmp,27)
  1063.                     CASE "g"
  1064.                         tmp:=addchar(tmp,7)
  1065.                     CASE "b"
  1066.                         tmp:=addchar(tmp,8)
  1067.                     CASE "f"
  1068.                         tmp:=addchar(tmp,12)
  1069.                     CASE "t"
  1070.                         tmp:=addchar(tmp,9)
  1071.                     DEFAULT     /* don't know it.. tell user */
  1072.                         fwriteerr('\n¡Can''t handle "\\\c" in format!\n',{j})
  1073.                 ENDSELECT
  1074.             DEFAULT       /* none of the formatting characters, so straight text */
  1075.                 tmp:=addchar(tmp,ch)
  1076.         ENDSELECT
  1077.     ENDFOR
  1078. EXCEPT
  1079.     Raise(exception)
  1080. ENDPROC tmp
  1081.  
  1082. /* dorandom()
  1083.  *
  1084.  * This is for readscript.. it randomly selects which line to take as an
  1085.  * option for whatever keyword is supposed to be handled randomly.
  1086.  * It returns with that line.
  1087.  */
  1088.  
  1089. PROC dorandom(file,col) HANDLE
  1090.     DEF tag=0,buf,i=0,c,j,firstline,nextline
  1091.     
  1092.     buf:=String(col)
  1093.     firstline:=Seek(file,0,OFFSET_CURRENT)  /* where ARE we? */
  1094.     LOOP
  1095.         CtrlC()
  1096.         nextline:=Seek(file,0,OFFSET_CURRENT)  /* where are we now? */
  1097.         i:=i+1
  1098.         Fgets(file,buf,col)                    /* read in line, to be sure not end*/
  1099.         IF buf[0]=" "
  1100.             tag:=updatetags(tag,[nextline])       /* it's cool.. store nextline in list*/
  1101.         ELSEIF buf[0]="#"                     /* ah.. end of list! */
  1102.             Dispose(buf)
  1103.             c:=Rnd(i-1)                          /* select which line from list*/
  1104.             buf:=ListItem(tag,c)                 /* get line position, and go there*/
  1105.             Seek(file,buf,OFFSET_BEGINNING)
  1106.             c:=String(col)                       /* make room for line */
  1107.             Fgets(file,c,col)                    /* get the line */
  1108.             j:=StrLen(c)
  1109.             c[j-1]:=0                            /* get rid of trailing \n */
  1110.             Seek(file,firstline,OFFSET_BEGINNING) /* now set to top, and find end */
  1111.             LOOP
  1112.                 CtrlC()
  1113.                 j:=FgetC(file)
  1114.                 IF j=10
  1115.                     j:=FgetC(file)
  1116.                     IF j="#"
  1117.                         FgetC(file)
  1118.                         RETURN c             /* found end.. return */
  1119.                     ENDIF
  1120.                 IF j=-1 THEN RETURN c  /* hmm.. eof instead.. return */
  1121.                 ENDIF
  1122.             ENDLOOP
  1123.         ELSE                    /* hmm.. probably bad formatting of RND list */
  1124.             fwriteerr('Warning: RND list in script may be corrupt.\n',0)
  1125.         ENDIF
  1126.     ENDLOOP
  1127. EXCEPT
  1128.     Raise(exception)
  1129. ENDPROC c
  1130.  
  1131. /* doserial()
  1132.  *
  1133.  * This is for readscript.. it parses through a list of options, and
  1134.  * sequentially selects which option to choose from.
  1135.  * It does this by checking the '*' character at the beginning of a line.
  1136.  * It'll move that '*' character down the list, moving back to the top
  1137.  * when it reaches the bottom.  Pretty cool, really.  Returns with the
  1138.  * option that had the "*" character, or the first line (if no "*" character
  1139.  * was found).
  1140.  */
  1141.  
  1142. PROC doserial(file,col) HANDLE
  1143.     DEF buf,c,firstline,lastline,j
  1144.     
  1145.     buf:=String(col)
  1146.     firstline:=Seek(file,0,OFFSET_CURRENT)  /* where are we, for the first line? */
  1147.     LOOP
  1148.         CtrlC()
  1149.         lastline:=Seek(file,0,OFFSET_CURRENT)  /* where are we again? */
  1150.         Fgets(file,buf,col)                    /* get buffer */
  1151.         SetStr(buf,j)                          /* make sure it's a String*/
  1152.         IF buf[0]="#"                          /* Hmm... it's the end of the list*/
  1153.             IF firstline=lastline THEN RETURN 0   /** bad list */
  1154.             Seek(file,firstline,OFFSET_BEGINNING) /** Since end of list, but not found*/
  1155.             FputC(file,"*")                       /* "*", we must place "*" in the right*/
  1156.             Flush(file)                           /* spot. */
  1157.             Seek(file,firstline,OFFSET_BEGINNING)
  1158.             Fgets(file,buf,col)
  1159.             SetStr(buf,j)
  1160.             Seek(file,lastline+2,OFFSET_BEGINNING)
  1161.             RETURN buf
  1162.         ENDIF
  1163.         IF buf[0]="*"                     /* found "*", get string and set new "*"*/
  1164.             c:=Seek(file,0,OFFSET_CURRENT)
  1165.             j:=String(col)
  1166.             Fgets(file,j,col)
  1167.             IF j[0]="#"                      /* next line end-of-list, so put * at top*/
  1168.                 Seek(file,lastline,OFFSET_BEGINNING)
  1169.                 FputC(file," ")
  1170.                 Seek(file,lastline+1,OFFSET_BEGINNING)
  1171.                 Seek(file,firstline,OFFSET_BEGINNING)
  1172.                 FputC(file,"*")
  1173.                 LOOP                           /* everything's done, so go to end of list*/
  1174.                     CtrlC()
  1175.                     c:=Fgets(file,j,col)
  1176.                     IF c=-1 OR j[0]="#"
  1177.                         Seek(file,1,OFFSET_CURRENT)
  1178.                         RETURN buf
  1179.                     ENDIF
  1180.                 ENDLOOP
  1181.             ENDIF
  1182.             Seek(file,c,OFFSET_BEGINNING)
  1183.             FputC(file,"*")
  1184.             Seek(file,lastline,OFFSET_BEGINNING)
  1185.             FputC(file," ")
  1186.             LOOP
  1187.                 CtrlC()
  1188.                 c:=Fgets(file,j,col)
  1189.                 IF j[0]="#" OR c=-1
  1190.                     RETURN buf
  1191.                 ENDIF
  1192.             ENDLOOP
  1193.         ENDIF
  1194.     ENDLOOP
  1195. EXCEPT
  1196.     Raise(exception)
  1197. ENDPROC
  1198.  
  1199. /* goto()
  1200.  *
  1201.  * This searches for the appropriate LABEL keyword in a script.
  1202.  */
  1203.  
  1204. PROC goto(file,name,col) HANDLE
  1205.  
  1206.     DEF line,i
  1207.     
  1208.     line:=String(col)
  1209.     Seek(file,0,OFFSET_BEGINNING)
  1210.     WHILE i<>-1
  1211.         CtrlC()
  1212.         i:=Fgets(file,line,col)
  1213.         IF i=-1 THEN RETURN
  1214.         IF line[0]="#"
  1215.             IF InStr(line,'LABEL',0)<>-1
  1216.                 i:=Fgets(file,line,col)
  1217.                 IF InStr(line,name,0)<>-1 THEN RETURN
  1218.             ENDIF
  1219.         ENDIF
  1220.     ENDWHILE
  1221. EXCEPT
  1222. Raise (exception)
  1223. ENDPROC
  1224.  
  1225. /* addscript()
  1226.  *
  1227.  * Phew.. this closes the current script, saving rpos and filename to
  1228.  * the list, then opening the new filename.  If it can't open the new one,
  1229.  * it'll reopen the old one, and let you know the new one couldn't open.
  1230.  */
  1231.  
  1232. PROC addscript(scripttag,file,filename,col) HANDLE
  1233.     DEF rpos,name
  1234.     
  1235.     name:=String(col)
  1236.     rpos:=Seek(^file,0,OFFSET_CURRENT)-1
  1237.     NameFromFH(^file,name,col)
  1238.     scripttag:=updatetags(scripttag,[name,rpos])
  1239.     Close(^file)
  1240.     ^file:=Open(filename,MODE_OLDFILE)
  1241.     IF ^file=0
  1242.         ^file:=String(100)
  1243.         Fault(IoErr(),'QuipScript',^file,100)
  1244.         fwriteerr('¡Unable to script "\s"!\n',{filename})
  1245.         Dispose(^file)
  1246.         ^file:=0
  1247.         scripttag:=scriptback(scripttag,file)
  1248.         RETURN scripttag
  1249.     ENDIF
  1250. EXCEPT
  1251. Raise(exception)
  1252. ENDPROC scripttag
  1253.  
  1254. /* scriptback()
  1255.  *
  1256.  * This backs out of a script file, back to an older script file (if existing).
  1257.  */
  1258.  
  1259. PROC scriptback(scripttag,file) HANDLE
  1260.     DEF i,filename,fpos
  1261.     
  1262.     i:=ListLen(scripttag)
  1263.     IF scripttag=0
  1264.         IF ^file<>0
  1265.             Close(^file)
  1266.             ^file:=0
  1267.         ENDIF
  1268.         RETURN 0
  1269.     ENDIF
  1270.     IF i=2
  1271.         filename:=ListItem(scripttag,0)
  1272.         fpos:=ListItem(scripttag,1)
  1273.         IF ^file<>0
  1274.             Close(^file)
  1275.         ENDIF
  1276.         ^file:=Open(filename,MODE_OLDFILE)
  1277.         IF ^file=0
  1278.             ^file:=String(100)
  1279.             Fault(IoErr(),'QuipScript',^file,100)
  1280.             fwriteerr('¡Can''t open original scriptfile:\n\s\n\s\n',[filename,^file])
  1281.             Dispose(^file)
  1282.             ^file:=0
  1283.             RETURN 0
  1284.         ENDIF
  1285.         Seek(^file,fpos,OFFSET_BEGINNING)
  1286.         RETURN 0
  1287.     ENDIF
  1288.     filename:=ListItem(scripttag,i-2)
  1289.     fpos:=ListItem(scripttag,i-1)
  1290.     ^file:=Open(filename,MODE_OLDFILE)
  1291.     IF ^file=0
  1292.         ^file:=String(100)
  1293.         Fault(IoErr(),'QuipScript',^file,100)
  1294.         fwriteerr('¡Unable to reopen "\s"!\n',[filename,^file])
  1295.         Dispose(^file)
  1296.         ^file:=0
  1297.         scripttag:=scriptback(scripttag,file)
  1298.         RETURN scripttag
  1299.     ENDIF
  1300.     Seek(^file,fpos,OFFSET_BEGINNING)
  1301.     SetList(scripttag,i-2)
  1302. EXCEPT
  1303. Raise(exception)
  1304. ENDPROC scripttag
  1305.  
  1306. /* dochance()
  1307.  *
  1308.  * This handles the 'CHANCE' keyword in a script.  It checks to see if
  1309.  * the next statement is a list, and zips past it, if it should.
  1310.  */
  1311.  
  1312. PROC dochance(file,col,cmp) HANDLE
  1313.     DEF line
  1314.     
  1315.     line:=String(col)
  1316.     IF Rnd(1000)<cmp
  1317.         RETURN
  1318.     ENDIF
  1319.     LOOP
  1320.         CtrlC()
  1321.         IF Fgets(^file,line,col)=-1 THEN RETURN
  1322.         IF line[0]="#"
  1323.             IF (InStr(line,'RND',0)<>-1) OR (InStr(line,'SEQ',0)<>-1)
  1324.                 LOOP
  1325.                     CtrlC()
  1326.                     IF Fgets(^file,line,col)=-1 THEN RETURN
  1327.                     IF line[0]="#"
  1328.                         Seek(^file,-1,OFFSET_CURRENT)
  1329.                         RETURN
  1330.                     ENDIF
  1331.                 ENDLOOP
  1332.             ENDIF
  1333.             Seek(^file,1,OFFSET_CURRENT)
  1334.             RETURN
  1335.         ENDIF
  1336.     ENDLOOP
  1337. EXCEPT
  1338.     Raise(exception)
  1339. ENDPROC
  1340.  
  1341. /* listwhichcom()
  1342.  *
  1343.  * This figures out which command Quip should do (should help reduce code
  1344.  * size exponentially, and make updates easier).
  1345.  */
  1346.  
  1347. PROC listwhichcom(line)
  1348.     DEF whichdo=0
  1349.     IF InStr(line,'IN_FILE',0)<>-1
  1350.         whichdo:=LIST_IN_FILE
  1351.     ELSEIF InStr(line,'OUT_FILE',0)<>-1
  1352.         whichdo:=LIST_OUT_FILE
  1353.     ELSEIF InStr(line,'FILE_FORMAT',0)<>-1
  1354.         whichdo:=LIST_FFORMAT
  1355.     ELSEIF InStr(line,'FILE_PREFIX',0)<>-1
  1356.         whichdo:=LIST_FPREFIX
  1357.     ELSEIF InStr(line,'FILE_SUFFIX',0)<>-1
  1358.         whichdo:=LIST_FSUFFIX
  1359.     ELSEIF InStr(line,'FILE_MIDDLE',0)<>-1
  1360.         whichdo:=LIST_FMIDDLE
  1361.     ELSEIF InStr(line,'FORMAT',0)<>-1
  1362.         whichdo:=LIST_FORMAT
  1363.     ELSEIF InStr(line,'PREFIX',0)<>-1
  1364.         whichdo:=LIST_PREFIX
  1365.     ELSEIF InStr(line,'SUFFIX',0)<>-1
  1366.         whichdo:=LIST_SUFFIX
  1367.     ELSEIF InStr(line,'MIDDLE',0)<>-1
  1368.         whichdo:=LIST_MIDDLE
  1369.     ELSEIF InStr(line,'GOTO',0)<>-1
  1370.         whichdo:=LIST_GOTO
  1371.     ELSEIF InStr(line,'SCRIPT',0)<>-1
  1372.         whichdo:=LIST_SCRIPT
  1373.     ELSEIF InStr(line,'CHANCE',0)<>-1
  1374.         whichdo:=LIST_CHANCE
  1375.     ELSEIF InStr(line,'ERROR',0)<>-1
  1376.         whichdo:=LIST_ERROR
  1377.     ELSEIF InStr(line,'RUN',0)<>-1
  1378.         whichdo:=LIST_RUN
  1379.     ELSE
  1380.         whichdo:=BADCOMMAND
  1381.     ENDIF
  1382. ENDPROC whichdo
  1383.  
  1384. /* readscript()
  1385.  *
  1386.  * This is another monster... this handles reading scriptfiles, and
  1387.  * properly interpreting the results within.  It builds a taglist which
  1388.  * is supposed to be passed to findquips() later.
  1389.  */
  1390.  
  1391. PROC readscript(filename,col) HANDLE
  1392.     DEF tag=0,file=0,c=0,line,check,filelist,whichdo,scripttag=0,comwrite=1
  1393.     IF col=0 THEN col:=80
  1394.     line:=String(col)
  1395.  
  1396.     file:=Open(filename,MODE_OLDFILE)
  1397.     IF file=0
  1398.         file:=String(100)
  1399.         Fault(IoErr(),'QuipScript',file,100)
  1400.         fwriteerr('¡Can''t open "\s" for scripting!\n\s\n',[filename,file])
  1401.         Dispose(file)
  1402.         file:=0
  1403.         RETURN 0
  1404.     ENDIF
  1405.     WHILE (c<>"@") AND (c<>-1)  /* keep hacking away until EOF, or a quip is found */
  1406.         CtrlC()
  1407.         c:=FgetC(file)
  1408.         WHILE c=10  /* a newline character! */
  1409.             CtrlC()
  1410.             c:=FgetC(file)
  1411.             IF c="#"   /* we have a command! (maybe) */
  1412.                 check:=Fgets(file,line,col)             /* get the line */
  1413.                 IF check=0 THEN RETURN tag              /* no line..EOF? very bad */
  1414.                 IF InStr(line,'RND',0)<>-1              /* Is this a RND list? */
  1415.                     filelist:=dorandom(file,col)
  1416.                     whichdo:=listwhichcom(line)
  1417.                 ELSEIF InStr(line,'SEQ',0)<>-1    /* is this a SEQ list?*/
  1418.                     filelist:=doserial(file,col)
  1419.                     whichdo:=listwhichcom(line)
  1420.                 ELSEIF InStr(line,'IN_FILE',0)<>-1    /* oh.. it's just a command */
  1421.                     whichdo:=IN_FILE
  1422.                 ELSEIF InStr(line,'OUT_FILE',0)<>-1 
  1423.                     whichdo:=OUT_FILE
  1424.                 ELSEIF InStr(line,'FILE_FORMAT',0)<>-1
  1425.                     whichdo:=FFORMAT
  1426.                 ELSEIF InStr(line,'FILE_PREFIX',0)<>-1
  1427.                     whichdo:=FPREFIX
  1428.                 ELSEIF InStr(line,'FILE_SUFFIX',0)<>-1
  1429.                     whichdo:=FSUFFIX
  1430.                 ELSEIF InStr(line,'FILE_MIDDLE',0)<>-1
  1431.                     whichdo:=FMIDDLE
  1432.                 ELSEIF InStr(line,'FORMAT',0)<>-1
  1433.                     whichdo:=FORMAT
  1434.                 ELSEIF InStr(line,'PREFIX',0)<>-1
  1435.                     whichdo:=PREFIX
  1436.                 ELSEIF InStr(line,'SUFFIX',0)<>-1
  1437.                     whichdo:=SUFFIX
  1438.                 ELSEIF InStr(line,'MIDDLE',0)<>-1
  1439.                     whichdo:=MIDDLE
  1440.                 ELSEIF InStr(line,'MAKETABLE',0)<>-1
  1441.                     whichdo:=MAKETABLE
  1442.                 ELSEIF InStr(line,'DISPLAY',0)<>-1
  1443.                     whichdo:=DISPLAY
  1444.                 ELSEIF InStr(line,'MAKE_QUIPS',0)<>-1
  1445.                     whichdo:=MAKE_QUIPS
  1446.                 ELSEIF InStr(line,'HOWMANY',0)<>-1
  1447.                     whichdo:=HOWMANY
  1448.                 ELSEIF InStr(line,'RANDOM',0)<>-1
  1449.                     whichdo:=RANDOM
  1450.                 ELSEIF InStr(line,'SERIAL',0)<>-1
  1451.                     whichdo:=SERIAL
  1452.                 ELSEIF InStr(line,'CHANCE',0)<>-1
  1453.                     whichdo:=CHANCE
  1454.                 ELSEIF InStr(line,'WHICHQUIP',0)<>-1
  1455.                     whichdo:=WHICHQUIP
  1456.                 ELSEIF InStr(line,'GOTO',0)<>-1
  1457.                     whichdo:=GOTO
  1458.                 ELSEIF InStr(line,'LABEL',0)<>-1
  1459.                     whichdo:=DONOTHING
  1460.                 ELSEIF InStr(line,'SCRIPT',0)<>-1
  1461.                     whichdo:=SCRIPT
  1462.                 ELSEIF InStr(line,'REQ',0)<>-1
  1463.                     whichdo:=QREQ
  1464.                 ELSEIF InStr(line,'DELAY',0)<>-1
  1465.                     whichdo:=QUIPDELAY
  1466.                 ELSEIF InStr(line,'RESET',0)<>-1
  1467.                     whichdo:=QRESET
  1468.                 ELSEIF InStr(line,'UPDATE',0)<>-1
  1469.                     whichdo:=UPDATE
  1470.                 ELSEIF InStr(line,'ERROR',0)<>-1
  1471.                     whichdo:=ERROR
  1472.                 ELSEIF InStr(line,'OTHER_ECHO',0)<>-1
  1473.                     whichdo:=BADCOMWRITE
  1474.                 ELSEIF InStr(line,'RUN',0)<>-1
  1475.                     whichdo:=RUN
  1476.                 ELSEIF InStr(line,'FINISHED',0)<>-1
  1477.                     whichdo:=FINISHED
  1478.                 ELSE
  1479.                     whichdo:=BADCOMMAND
  1480.                 ENDIF
  1481.                 SELECT whichdo            /* we know what it says.. so let's do it*/
  1482.                     CASE LIST_IN_FILE
  1483.                         tag:=updatetags(tag,[QTAG_INFILENAME,filelist+1])
  1484.                     CASE LIST_OUT_FILE
  1485.                         tag:=updatetags(tag,[QTAG_OUTFILENAME,filelist+1])
  1486.                     CASE LIST_FORMAT
  1487.                         filelist:=modformat(filelist+1)
  1488.                         tag:=updatetags(tag,[QTAG_FORMAT,filelist])
  1489.                     CASE LIST_PREFIX
  1490.                         tag:=updatetags(tag,[QTAG_PREFIX,filelist+1])
  1491.                     CASE LIST_FPREFIX
  1492.                         tag:=updatetags(tag,[QTAG_FPREFIX,filelist])
  1493.                     CASE LIST_SUFFIX
  1494.                         tag:=updatetags(tag,[QTAG_SUFFIX,filelist+1])
  1495.                     CASE LIST_FSUFFIX
  1496.                         tag:=updatetags(tag,[QTAG_FSUFFIX,filelist])
  1497.                     CASE LIST_MIDDLE
  1498.                         tag:=updatetags(tag,[QTAG_MIDDLE,filelist+1])
  1499.                     CASE LIST_FMIDDLE
  1500.                         tag:=updatetags(tag,[QTAG_FMIDDLE,filelist])
  1501.                     CASE LIST_GOTO
  1502.                         goto(file,filelist+1,col)
  1503.                     CASE LIST_SCRIPT
  1504.                         scripttag:=addscript(scripttag,{file},filelist+1,col)
  1505.                     CASE LIST_CHANCE
  1506.                         dochance({file},col,Val(filelist+1,0))
  1507.                     CASE LIST_ERROR
  1508.                         efilename:=filelist+1
  1509.                     CASE LIST_RUN
  1510.                         tag:=updatetags(tag,[QTAG_RUN,filelist+1])
  1511.                     CASE IN_FILE
  1512.                         Fgets(file,line,col)
  1513.                         check:=StrLen(line)-1
  1514.                         line[check]:=0
  1515.                         line:=line+1
  1516.                         tag:=updatetags(tag,[QTAG_INFILENAME,line])
  1517.                         line:=String(col)
  1518.                     CASE OUT_FILE
  1519.                         Fgets(file,line,col)
  1520.                         check:=StrLen(line)-1
  1521.                         line[check]:=0
  1522.                         line:=line+1
  1523.                         tag:=updatetags(tag,[QTAG_OUTFILENAME,line])
  1524.                         line:=String(col)
  1525.                     CASE RUN
  1526.                         Fgets(file,line,col)
  1527.                         check:=StrLen(line)-1
  1528.                         line[check]:=0
  1529.                         line:=line+1
  1530.                         tag:=updatetags(tag,[QTAG_RUN,line])
  1531.                         line:=String(col)
  1532.                     CASE QREQ
  1533.                         tag:=updatetags(tag,[QTAG_REQUSE])
  1534.                     CASE QUIPDELAY
  1535.                         Fgets(file,line,col)
  1536.                         tag:=updatetags(tag,[QTAG_DELAY,Val(line,0)])
  1537.                     CASE QRESET
  1538.                         tag:=updatetags(tag,[QTAG_RESET])
  1539.                     CASE UPDATE
  1540.                         Fgets(file,line,col)
  1541.                         tag:=updatetags(tag,[QTAG_UPDATE,Val(line,0)])
  1542.                     CASE FORMAT
  1543.                         Fgets(file,line,col)
  1544.                         check:=StrLen(line)-1
  1545.                         line[check]:=0
  1546.                         filelist:=modformat(line+1)
  1547.                         IF filelist<>0
  1548.                             tag:=updatetags(tag,[QTAG_FORMAT,filelist])
  1549.                         ENDIF
  1550.                     CASE FFORMAT
  1551.                         Fgets(file,line,col)
  1552.                         check:=StrLen(line)-1
  1553.                         line[check]:=0
  1554.                         tag:=updatetags(tag,[QTAG_FFORMAT,filelist])
  1555.                         line:=String(col)
  1556.                     CASE PREFIX
  1557.                         Fgets(file,line,col)
  1558.                         check:=StrLen(line)-1
  1559.                         line[check]:=0
  1560.                         line:=line+1
  1561.                         tag:=updatetags(tag,[QTAG_PREFIX,line])
  1562.                         line:=String(col)
  1563.                     CASE FPREFIX
  1564.                         Fgets(file,line,col)
  1565.                         check:=StrLen(line)-1
  1566.                         line[check]:=0
  1567.                         tag:=updatetags(tag,[QTAG_FPREFIX,line+1])
  1568.                         line:=String(col)
  1569.                     CASE SUFFIX
  1570.                         Fgets(file,line,col)
  1571.                         check:=StrLen(line)-1
  1572.                         line[check]:=0
  1573.                         line:=line+1
  1574.                         tag:=updatetags(tag,[QTAG_SUFFIX,line])
  1575.                         line:=String(col)
  1576.                     CASE FSUFFIX
  1577.                         Fgets(file,line,col)
  1578.                         check:=StrLen(line)-1
  1579.                         line[check]:=0
  1580.                         tag:=updatetags(tag,[QTAG_FSUFFIX,line+1])
  1581.                         line:=String(col)
  1582.                     CASE MIDDLE
  1583.                         Fgets(file,line,col)
  1584.                         check:=StrLen(line)-1
  1585.                         line[check]:=0
  1586.                         line:=line+1
  1587.                         tag:=updatetags(tag,[QTAG_MIDDLE,line])
  1588.                         line:=String(col)
  1589.                     CASE FMIDDLE
  1590.                         Fgets(file,line,col)
  1591.                         check:=StrLen(line)-1
  1592.                         line[check]:=0
  1593.                         tag:=updatetags(tag,[QTAG_FMIDDLE,line+1])
  1594.                         line:=String(col)
  1595.                     CASE MAKETABLE
  1596.                         tag:=updatetags(tag,[QTAG_GENQTABLE])
  1597.                     CASE DISPLAY
  1598.                         tag:=updatetags(tag,[QTAG_DISPLAY])
  1599.                     CASE MAKE_QUIPS
  1600.                         tag:=updatetags(tag,[QTAG_END])
  1601.                     CASE HOWMANY
  1602.                         Fgets(file,line,col)
  1603.                         check:=StrLen(line)-1
  1604.                         line[check]:=0
  1605.                         tag:=updatetags(tag,[QTAG_NUMQUIPS,Val(line,0)])
  1606.                         line:=String(col)
  1607.                     CASE RANDOM
  1608.                         tag:=updatetags(tag,[QTAG_RANDOM])
  1609.                     CASE SERIAL
  1610.                         tag:=updatetags(tag,[QTAG_SERIAL])
  1611.                     CASE WHICHQUIP
  1612.                         Fgets(file,line,col)
  1613.                         tag:=updatetags(tag,[QTAG_WHICHQUIP,Val(line,0)])
  1614.                     CASE BADCOMMAND
  1615.                         IF comwrite
  1616.                             tag:=updatetags(tag,[QTAG_STDOUT,line])
  1617.                         ELSE
  1618.                             tag:=updatetags(tag,[QTAG_STDERR,line])
  1619.                         ENDIF
  1620.                         line:=String(col)
  1621.                     CASE GOTO
  1622.                         Fgets(file,line,col)
  1623.                         goto(file,line,col)
  1624.                     CASE BADCOMWRITE
  1625.                         IF comwrite=0
  1626.                             comwrite:=1
  1627.                         ELSE
  1628.                             comwrite:=0
  1629.                         ENDIF
  1630.                     CASE SCRIPT
  1631.                         Fgets(file,line,col)
  1632.                         check:=StrLen(line)-1
  1633.                         line[check]:=0
  1634.                         line:=line+1
  1635.                         scripttag:=addscript(scripttag,{file},line,col)
  1636.                         line:=String(col)
  1637.                     CASE CHANCE
  1638.                         Fgets(file,line,col)
  1639.                         check:=StrLen(line)-1
  1640.                         line[check]:=0
  1641.                         line:=line+1
  1642.                         check:=Val(line,0)
  1643.                         line:=line-1
  1644.                         dochance({file},col,check)
  1645.                     CASE ERROR
  1646.                         Fgets(file,line,col)
  1647.                         check:=StrLen(line)-1
  1648.                         line[check]:=0
  1649.                         line:=line+1
  1650.                         efilename:=line
  1651.                         line:=String(col)
  1652.                     CASE FINISHED
  1653.                         Seek(file,0,OFFSET_END)  /* yeah yeah, I know.. ugly */
  1654.                     CASE DONOTHING
  1655.                     DEFAULT
  1656.                         fwriteerr('\n¡Internal Error: readscript()!\n',0)
  1657.                 ENDSELECT
  1658.                 Seek(file,-2,OFFSET_CURRENT) /* need to back to enough to catch \n char */
  1659.             ELSEIF (c="@") OR (c=-1)         /* hmm. eof or a quip*/
  1660.                 IF file AND (scripttag=0)
  1661.                     Close(file)
  1662.                     RETURN tag
  1663.                 ELSEIF scripttag AND file
  1664.                     scripttag:=scriptback(scripttag,{file})
  1665.                     IF (scripttag=0) AND (file=0)
  1666.                         RETURN tag
  1667.                     ELSE
  1668.                         c:="4"                       /* make c equal ANYTHING but anything important*/
  1669.                         Seek(file,-1,OFFSET_CURRENT)
  1670.                     ENDIF
  1671.                 ELSEIF (scripttag=0) AND (file=0)
  1672.                     RETURN tag
  1673.                 ENDIF
  1674.             ENDIF
  1675.         ENDWHILE
  1676.     ENDWHILE
  1677.     IF file<>0 THEN Close(file)
  1678. EXCEPT
  1679.     IF file<>0 THEN Close(file)
  1680.     Raise(exception)
  1681. ENDPROC tag
  1682.  
  1683. /* main()
  1684.  *
  1685.  * Well, gee, it'd be funny to run a program without MAIN!
  1686.  *
  1687.  * Main mostly handles arguments.. but it has to take into account tooltypes or
  1688.  * arguments.  It also has to take into account how to manage certain things,
  1689.  * in case some argument is used that should make Quip quit (before doing
  1690.  * anything else, eg. running a SCRIPT ignores most of the other tooltypes).
  1691.  * I also implemented the exthelp part of the ReadArgs, in order to avail
  1692.  * myself of THAT convention <grin>.  More people should.
  1693.  */
  1694.  
  1695. PROC main() HANDLE
  1696.  
  1697. DEF tag=0,args[ARG_MAX]:LIST,templ,myarg:PTR TO rdargs,rdarg=0,i,
  1698.     diskob:PTR TO diskobject, tmptag=0,
  1699.     tools, tooltype1, col=81, arg_format, wbargs,
  1700.     arghelp, infiledefault, moo
  1701.  
  1702.     myarg:=0
  1703.     arg_format := 'V=VERSION/S,M=MOO/S,C=COL/N,D=DATA/K,T=TABLE/S,RUN/K,' +
  1704.                'FFM=FFORMAT/K,FM=FORMAT/K,P=PRE/K,FP=FPRE/K,S=SUF/K,' +
  1705.                'FS=FSUF/K,W=WHICH/N,R=RANDOM/S,E=ERROR/K,' +
  1706.                'MID=MIDDLE/K,FMID=FMIDDLE/K,O=DISPLAY/S,REQ/S,DE=DELAY/N,' +
  1707.                'N=NUM/N,U=UPDATE/N,' +
  1708.                'F=FILES/K,SC=SCRIPT/K'
  1709.  
  1710.     wbargs:=['VERSION','MOO','COL','DATA','TABLE','RUN','FFORMAT','FORMAT','PRE',
  1711.                  'FPRE','SUF','FSUF',
  1712.                  'WHICH','RANDOM','ERROR','MIDDLE','FMIDDLE','DISPLAY','REQ',
  1713.                  'DELAY','NUM',
  1714.                  'UPDATE','FILES','SCRIPT']
  1715.  
  1716.     arghelp :=  'Usage: Quip [DATA <File>] [PRE <File>] [SUF <File>] [SCRIPT <File>]\n' +
  1717. '            [WHICH <Number>] [RANDOM] [STDIO] [TABLE] [FORMAT]\n' +
  1718. '            [NUM <Number>] [COL] [FILES <Outgoing File>] [REQ]\n' +
  1719. '            [DELAY] <Number> [UPDATE] <Number> [VERSION] [ERROR] <File>\n\n' +
  1720. '      Data = Which file to use for processing a quip\n' +
  1721. '       Pre = A file holding text you''d like to preface your quip[s] with\n' +
  1722. '       Suf = A file holding text you''d like to suffix your quip[s] with\n' +
  1723. '    Script = A file with a script of stuff you want Quip to do\n' +
  1724. '     Which = Which quip (by number) from the datafile you want to start from\n' +
  1725. '    Random = Randomly select a quip\n' +
  1726. '     Stdio = Write quips to standard IO (useful when used with Table)\n' +
  1727. '     Table = Create a tablefile for the datafile\n' +
  1728. '    Format = From CLI, specifies a file from which to create formatted text\n' +
  1729. '             appearing before the quip, but after the prefix file.\n' +
  1730. '             From WB, specifies text to format.\n' +
  1731. '       Num = Number of quips to generate (defaults to 1)\n' +
  1732. '       Col = Number of columns in a scriptfile (defaults to 80 characters)\n' +
  1733. '       Req = Have a reqtools.library requester display the quip.\n' +
  1734. '     Delay = Same as above, but turn off the requester after <num> 10thsecs.\n' +
  1735. '    Update = Update a tablefile from a specific quip, or the last known quip.\n' +
  1736. '   Version = Displays which version of Quip per $VER string.\n' +
  1737. '     Error = Filename you want errors & junk to be sent to.\n' +
  1738. '     Files = Write Num quips to the file specified\n'
  1739.  
  1740.     moo := '     Moo.   (___)                  \e[4mQuip\e[24m\n' +
  1741. '       \\   _|oo |_______,\n' +
  1742. '          `\\__,   (   ( )\\.        \e[2mC\e[0mheese\n' +
  1743. '             \\_   `(__) | |        \e[2mO\e[0mlfactory\n' +
  1744. '              ||-||____|| `        \e[2mW\e[0morkshop\n' +
  1745. '       \\|/    || ||   |||   \\|/    \e[1mProduction\e[0m\n' +
  1746. '              `'' `''   ``''\n\n' +
  1747. 'So!  You chose the MOO parameter.  Well, what are you doing experimenting\n' +
  1748. 'with undocumented commands?  You ought to be ashamed of yourselves.  You\n' +
  1749. 'could have hurt Bessie, or even worse, yourself.\n\n' +
  1750. '"I can''t believe the *ABSOLUTE* pomposity."\n' +
  1751. '                             - Piouhgd\n\n' +
  1752. '"So who''s this Hue, Jr. guy, anyway?"\n' +
  1753. '                             - Someone Evil\n\n' +
  1754. '"This possibility exists."\n' +
  1755. '                             - Machine\n'
  1756.  
  1757.     infiledefault := 'S:quip.dat'
  1758.     diskob:=0
  1759.  
  1760.     stayrandom()
  1761.  
  1762.     IF wbmessage=NIL  /* IF called from CLI, get ReadArgs ready */
  1763.         FOR i:=0 TO ARG_MAX
  1764.             args[i]:=0
  1765.         ENDFOR
  1766.         myarg:=AllocDosObject(DOS_RDARGS, TAG_DONE)
  1767.         myarg.exthelp := arghelp
  1768.         templ:=arg_format
  1769.         rdarg:=ReadArgs(templ,args,myarg)
  1770.         IF rdarg=NIL THEN Raise("ARG")
  1771.     ELSE              /* IF called from Icon, get ToolTypes ready */
  1772.         IF (iconbase:=OpenLibrary('icon.library',37))=0 THEN Raise("LIB")
  1773.  
  1774.         diskob:=getprogramicon(wbmessage)
  1775.  
  1776.         IF diskob<>0
  1777.             tools:=diskob.tooltypes
  1778.         ELSE
  1779.             Raise("ICON")
  1780.         ENDIF
  1781.     ENDIF
  1782.     FOR i:=0 TO ARG_MAX-1
  1783.         CtrlC()
  1784.         IF wbmessage<>NIL  /* IF from Icon, get arguments from icon tooltypes */
  1785.             tooltype1:=FindToolType(tools,ListItem(wbargs,i))
  1786.         ELSE               /* IF from CLI, get arguments from arguments */
  1787.             tooltype1:=args[i]
  1788.         ENDIF
  1789.         SELECT i
  1790.             CASE ARG_VERSION
  1791.                 IF tooltype1<>0
  1792.                     tag:=updatetags(tag,[QTAG_VERSION])
  1793.                 ENDIF
  1794.             CASE ARG_MOO
  1795.                 IF tooltype1<>0
  1796.                     WriteF(moo)
  1797.                     Raise(0)
  1798.                 ENDIF
  1799.             CASE ARG_COL
  1800.                 IF tooltype1<>0
  1801.                     IF wbmessage<>NIL
  1802.                         col:=Val(tooltype1,0)
  1803.                     ELSE
  1804.                         col:=^tooltype1
  1805.                     ENDIF
  1806.                 ENDIF
  1807.             CASE ARG_RUN
  1808.                 IF tooltype1<>0
  1809.                     tag:=updatetags(tag,[QTAG_RUN,tooltype1])
  1810.                 ENDIF
  1811.             CASE ARG_SCRIPT
  1812.                 IF tooltype1<>0
  1813.                     IF StrCmp(tooltype1,'NIL:',ALL)=FALSE
  1814.                         tmptag:=readscript(tooltype1,col)
  1815.                         IF tmptag
  1816.                             tag:=updatetags(tag,tmptag)
  1817.                             IF tag<>0
  1818.                                 findquip(tag)
  1819.                             ENDIF
  1820.                             Raise(0)
  1821.                         ELSE
  1822.                             Raise(QERR_BADSFILE)
  1823.                         ENDIF
  1824.                     ENDIF
  1825.                 ELSE
  1826.                     IF FileLength('s:quip.script')>0  /*if default script exists*/
  1827.                         tmptag:=readscript('s:quip.script',col)
  1828.                         IF tmptag
  1829.                             tag:=updatetags(tag,tmptag)
  1830.                             findquip(tag)
  1831.                             Raise(0)
  1832.                         ELSE
  1833.                             Raise(QERR_BADSFILE)
  1834.                         ENDIF
  1835.                     ENDIF
  1836.                 ENDIF
  1837.             CASE ARG_DATAFILE
  1838.                 IF tooltype1=0
  1839.                     tag:=updatetags(tag,[QTAG_INFILENAME,infiledefault])
  1840.                 ELSE
  1841.                     tag:=updatetags(tag,[QTAG_INFILENAME,tooltype1])
  1842.                 ENDIF
  1843.             CASE ARG_TABLE
  1844.                 IF tooltype1<>0
  1845.                     tag:=updatetags(tag,[QTAG_GENQTABLE])
  1846.                     findquip(tag)
  1847.                     Raise(0)
  1848.                 ENDIF
  1849.             CASE ARG_ERROR
  1850.                 IF tooltype1<>0
  1851.                     efilename:=tooltype1
  1852.                 ELSE
  1853.                     efilename:=0
  1854.                 ENDIF
  1855.             CASE ARG_FFORMAT
  1856.                 IF tooltype1<>0
  1857.                     tag:=updatetags(tag,[QTAG_FFORMAT,tooltype1])
  1858.                 ENDIF
  1859.             CASE ARG_FORMAT
  1860.                 IF tooltype1<>0
  1861.                     tag:=updatetags(tag,[QTAG_FORMAT,tooltype1])
  1862.                 ENDIF
  1863.             CASE ARG_FPRE
  1864.                 IF tooltype1<>0
  1865.                     tag:=updatetags(tag,[QTAG_FPREFIX,tooltype1])
  1866.                 ENDIF
  1867.             CASE ARG_PRE
  1868.                 IF tooltype1<>0
  1869.                     tag:=updatetags(tag,[QTAG_PREFIX,tooltype1])
  1870.                 ENDIF
  1871.             CASE ARG_FSUF
  1872.                 IF tooltype1<>0
  1873.                     tag:=updatetags(tag,[QTAG_FSUFFIX,tooltype1])
  1874.                 ENDIF
  1875.             CASE ARG_SUF
  1876.                 IF tooltype1<>0
  1877.                     tag:=updatetags(tag,[QTAG_SUFFIX,tooltype1])
  1878.                 ENDIF
  1879.             CASE ARG_FMIDDLE
  1880.                 IF tooltype1<>0
  1881.                     tag:=updatetags(tag,[QTAG_FMIDDLE,tooltype1])
  1882.                 ENDIF
  1883.             CASE ARG_MIDDLE
  1884.                 IF tooltype1<>0
  1885.                     tag:=updatetags(tag,[QTAG_MIDDLE,tooltype1])
  1886.                 ENDIF
  1887.             CASE ARG_WHERE
  1888.                 IF tooltype1<>0
  1889.                     IF wbmessage<>NIL
  1890.                         tag:=updatetags(tag,[QTAG_WHICHQUIP,Val(tooltype1,0)])
  1891.                     ELSE
  1892.                         tag:=updatetags(tag,[QTAG_WHICHQUIP,^tooltype1])
  1893.                     ENDIF
  1894.                 ENDIF
  1895.             CASE ARG_RANDOM
  1896.                 IF tooltype1<>0
  1897.                     tag:=updatetags(tag,[QTAG_RANDOM])
  1898.                 ENDIF
  1899.             CASE ARG_STDIO
  1900.                 IF tooltype1<>0
  1901.                     tag:=updatetags(tag,[QTAG_DISPLAY])
  1902.                 ENDIF
  1903.             CASE ARG_NUM
  1904.                 IF tooltype1<>0
  1905.                     IF wbmessage<>NIL
  1906.                         tag:=updatetags(tag,[QTAG_NUMQUIPS,Val(tooltype1,0)])
  1907.                     ELSE
  1908.                         tag:=updatetags(tag,[QTAG_NUMQUIPS,^tooltype1])
  1909.                     ENDIF
  1910.                 ENDIF
  1911.             CASE ARG_UPDATE
  1912.                 IF tooltype1<>0
  1913.                     IF wbmessage<>NIL
  1914.                         tag:=updatetags(tag,[QTAG_UPDATE,Val(tooltype1,0)])
  1915.                     ELSE
  1916.                         tag:=updatetags(tag,[QTAG_UPDATE,^tooltype1])
  1917.                     ENDIF
  1918.                     findquip(tag)
  1919.                     Raise(0)
  1920.                 ENDIF
  1921.             CASE ARG_REQ
  1922.                 IF tooltype1<>0
  1923.                     tag:=updatetags(tag,[QTAG_REQUSE])
  1924.                 ENDIF
  1925.             CASE ARG_DELAY
  1926.                 IF tooltype1<>0
  1927.                     IF wbmessage<>NIL
  1928.                         tag:=updatetags(tag,[QTAG_DELAY,Val(tooltype1,0)])
  1929.                     ELSE
  1930.                         tag:=updatetags(tag,[QTAG_DELAY,^tooltype1])
  1931.                     ENDIF
  1932.                 ENDIF
  1933.             CASE ARG_FILES
  1934.                 IF tooltype1<>0
  1935.                     tag:=updatetags(tag,[QTAG_OUTFILENAME,tooltype1])
  1936.                 ENDIF
  1937.             DEFAULT
  1938.                 fwriteerr('¡Internal error: PROC main()!\n',0)
  1939.         ENDSELECT
  1940.     ENDFOR
  1941.     IF tag<>0
  1942.         tag:=updatetags(tag,[QTAG_END])
  1943.     ELSE
  1944.         tag:=updatetags(tag,[QTAG_VERSION])
  1945.         findquip(tag)
  1946.         WriteF(arghelp)
  1947.         Raise(0)
  1948.     ENDIF
  1949.     findquip(tag)
  1950.     Raise(0)
  1951. EXCEPT
  1952.     IF myarg THEN FreeDosObject(DOS_RDARGS,myarg)
  1953.     IF rdarg THEN FreeArgs(rdarg)
  1954.     IF iconbase THEN CloseLibrary(iconbase)
  1955.     IF diskob THEN FreeDiskObject(diskob)
  1956.     IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  1957.     myarg:=IoErr()
  1958.     SELECT exception
  1959.         CASE 0
  1960.             tag:=0
  1961.         CASE "ARG"
  1962.             tag:=10
  1963.         CASE "^C"
  1964.             SetIoErr(ERROR_BREAK)
  1965.             tag:=10
  1966.         CASE "MEM"
  1967.             fwriteerr('Quip: unable to allocate memory\n',0)
  1968.             SetIoErr(myarg)
  1969.             tag:=10
  1970.         CASE "LIB"
  1971.             fwriteerr('Quip: unable to open icon.library version 37 or better\n',0)
  1972.             SetIoErr(myarg)
  1973.             tag:=10
  1974.         CASE "ICON"
  1975.             fwriteerr('Quip: bad icon\n',0)
  1976.             SetIoErr(myarg)
  1977.             tag:=10
  1978.         DEFAULT
  1979.             tag:=10
  1980.     ENDSELECT
  1981.     IF tag=10
  1982.         tag:=IoErr()
  1983.         IF (((tag>102) AND (tag<243)) OR ((tag>303) AND (tag<305))) AND (exception<>QERR_BADSFILE)
  1984.             tag:=String(100)
  1985.             Fault(IoErr(),'Quip',tag,100)
  1986.             fwriteerr('\s\n',{tag})
  1987.             Dispose(tag)
  1988.         ENDIF
  1989.         tag:=10
  1990.     ENDIF
  1991.     IF efile<>stdout
  1992.         Close(efile)
  1993.     ENDIF
  1994.     IF estate THEN fwriteerr('\nPress RETURN to close window',0)
  1995.     CleanUp(tag)
  1996. ENDPROC
  1997.