$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 17-JUN-1993 23:44:45.56   By user MASMUMMY 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 6 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. HELP.PURITY;1
$!       2. PURITY.C;1
$!       3. PURITY.DISCLAIMER;1
$!       4. PURITY.HLP;1
$!       5. PURITY.SCORE;1
$!       6. PURITY.TEST;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X
X               Type Yes or No for each answer(only Y or N is required).
X
X
X
X               Type the NUMBER of a note which you wish to read.
X
X
X
X               Type Q to stop the testing.
X
X
X
X               Type H to see this screen.
X           `20
$ CALL UNPACK HELP.PURITY;1 1782274292
$ create 'f'
X
X/* This program is exclusively inteded to work with the purity test version
V */
X/* 4.  I assume no liability or credit for making this mindless program and
V */
X/* I seek no credit nor claim any responsibility for creating it.
V           */
X
X#include stdio
X#include stdlib             /* atoi (character)             */
X#include smgdef             /* to make a real getchar()     */
X#include libdef             /* to get username for score    */
X#include descrip
X#include jpidef
X#define maxquest 500        /* number of qeustions total    */
X#define True 1
X#define False 0
X#define datafile "$1$dua12:`5Btemp.masmummy`5Dpurity.test"
X#define keep     "$1$dua12:`5Btemp.masmummy`5Dpurity.score"
X#define disclaim "$1$dua12:`5Btemp.masmummy`5Dpurity.disclaimer"
X#define savefile "sys$scratch:purity.results"
X
Xunsigned int keyboard;      /* so I can make getchar () work */
Xint current;                /* current question being asked  */
Xint yes;                    /* number of affimative answers  */
Xint save;                   /* boolean to control saving     */
Xint quit;                   /* for quitting DUH!             */
Xint show;                   /* analogous to echo on/off      */
Xchar line`5B81`5D;              /* string array to read from file*/
XFILE *fp;                   /* low and behold, file pointer  */
X
Xint xprint ()
X`7B
X  int a;
X  int b;
X  a = False;
X
X  printf ("\033<\033`5B1;1f\033`5BJ\033`5B0m\n");
X  printf ("\033`5B9;30HDo you want to make");
X  printf ("\033`5B10;30Ha printout of this?");
X
X  while (b != SMG$K_TRM_CTRLM )
X  `7B
X  if (b == SMG$K_TRM_UP ) ++a;
X  if (b == SMG$K_TRM_DOWN) --a;
X  if (a < 0) a = 1;
X  if (a > 1) a = 0;
X  if (a == 1)
X   `7B
X    printf ("\033`5B12;30HME? Not on my life!");
X    printf ("\033`5B7m\033`5B13;30HHOT DAMN!! Sure do!\033`5B0m");
X   `7D
X  if (a == 0)
X   `7B
X    printf ("\033`5B13;30HHOT DAMN!! Sure do!");
X    printf ("\033`5B7m\033`5B12;30HME? Not on my life!\033`5B0m");
X   `7D
X  smg$read_keystroke (&keyboard,&b);
X  `7D
X  return a;
X`7D
X
Xchar custgetchar()
X
X`7B
X  char a;
X
X  smg$read_keystroke (&keyboard,&a);
X  if (a == 'n' `7C`7C a =='N' )
X  `7B
X    if (show) printf ("no");
X    printf ("\n");
X    return 'n';
X  `7D
X  else if (a == 'y' `7C`7C a == 'Y')
X  `7B
X    if (show) printf ("yes");
X    printf ("\n");
X    return 'y';
X  `7D
X  else if (a == 'q' `7C`7C a == 'Q')
X  `7B
X    printf ("quit\n");
X    return 'q';
X  `7D
X  else if (a == 's' `7C`7C a == 'S')
X  `7B
X    printf ("save\n");
X    return 's';
X  `7D
X  if (show) printf ("Default is NO");
X  printf ("\n");
X  return 'n';
X`7D
X
X
Xint subint (char a`5B81`5D)    /* less messy than using strncpy */
X
X`7B
X  int b;
X  char c`5B5`5D;
X  int d;
X
X  d = 0;
X  for (b=1 ; b<5 ; ++b)
X  `7B
X    c`5Bb`5D = a`5Bb`5D;
X    if (!(c`5Bb`5D <= '9' && c`5Bb`5D >= '0')) c`5Bb`5D = '0';
X    d = 10.0 * d+(c`5Bb`5D - '0');
X  `7D
X  if (a`5B5`5D != '.') d = 0;
X  return d;
X`7D
X
Xvoid get_ans (int *quit, int *yes, int *save)  /* call with get_ans (&quit)
V */
X`7B
X  char b;
X
X  printf("Your answer? (y/`5BN`5D/q/s) ");
X  b = custgetchar();
X
X  if (b == 'q') *quit = True;
X  else if (b == 's') *save = True;
X  if (b == 'y') *yes= *yes + 1;
X  printf ("\n\n");
X`7D
X
Xint divider (char a`5B81`5D)
X
X`7B
X  if (strstr(a," ______________________________")!= NULL)  return True;
X  return False;
X`7D
X
Xchar *printdiv (int c)
X
X`7B
X  char b`5B81`5D;
X  int d;
X
X  d = 3;
X  fgets (b,132,fp);
X  fgets (b,132,fp);
X  printf ("\033<\033`5B1;1f\033`5BJ\033`5B0m\n");
X  printf (" ________________________________________________________________
V______________\n");
X  while (strstr(b,"Have you") == NULL)
X  `7B
X    ++d;
X    printf (b);
X    fgets (b,132,fp);
X  `7D
X  printf ("\033`5B%d;24r",d);
X  printf ("\033`5B%d;1H ____________________________________________________
V__________________________\n",d-1);
X  printf ("\033`5B22;1HHave you ever done any of the following:");
X  return b;
X`7D
X
Xchar *head ()
X
X`7B
X  char a`5B81`5D;
X  int d;
X
X  d = 3;
X  while (strstr(a," Section 1: ") == NULL)
X    fgets (a,132,fp);
X  printf ("\033<\033`5B1;1f\033`5BJ\033`5B0m\n");
X  printf (" ________________________________________________________________
V______________\n");
X  while (strstr(a,"Have you ever") == NULL)
X  `7B
X    ++d;
X    printf (a);
X    fgets (a,132,fp);
X  `7D
X  printf ("\033`5BA ________________________________________________________
V______________________\n");
X  printf ("\033`5B%d;24r",d);
X  printf ("\033`5B22;1HHave you ever done any of the following:");
X  return a;
X`7D
X
Xvoid percentage ()   /* puts up the percentage header at top    */
X
X`7B
X  char a`5B80`5D;                /* shows % pure                 */
X  char b`5B80`5D;                /* prints trailing blanks       */
X  int c;
X  int d;
X
X  printf ("\033(0");
X  printf ("\033`5B1;1H\033`5B7m");
X  if (current != 1)
X  `7B
X    for (c=1 ; c < (((current-yes-1)*80)/(current-1)) ; c++)
X      printf ("a");
X    printf ("\033`5B0m");
X    for (d=c ; d < 80 ; d++)
X      printf ("a");
X  `7D
X  else
X    printf ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
Vaaaaaaaaaaaaaaaa\033`5B0m");
X  printf ("\033(B");
X  printf ("\033`5B23;1H");
X`7D
X
Xvoid scoreme ()
X
X`7B
X  char user`5B12`5D;              /* username                      */
X  char time`5B80`5D;
X  char a`5B80`5D;
X  int b;
X  int c;
X  $DESCRIPTOR (datetime_d,time);
X  $DESCRIPTOR (udesc,user);
X
X  udesc.dsc$a_pointer = user;
X  udesc.dsc$w_length = sizeof(user);
X  lib$getjpi (&JPI$_USERNAME,0,0,0,&udesc);
X  if (current != 1) c = ((current-yes-1)*100)/(current-1);
X
X  datetime_d.dsc$w_length=23;
X  lib$date_time (&datetime_d);
X
X  user`5B12`5D = '\0';
X  for (b=0 ; b<12 ; b++)
X  `7B
X    if (user`5Bb`5D >= ' ' && user`5Bb`5D <= 'z' )
X      a`5Bb`5D = user`5Bb`5D;
X    else
X      a`5Bb`5D = ' ';
X  `7D
X  for (b=0; b <6 ; b++)
X  `7B
X    if (time`5Bb`5D >= ' ' && time`5Bb`5D <= 'z')
X      a`5Bb+12`5D = time`5Bb`5D;
X    else
X      a`5Bb+12`5D = ' ';
X  `7D
X  a`5B18`5D = ' ';
X  for (b=12; b <17 ; b++)
X  `7B
X    if (time`5Bb`5D >= ' ' && time`5Bb`5D <= 'z')
X      a`5Bb+7`5D = time`5Bb`5D;
X    else
X      a`5Bb+7`5D = ' ';
X  `7D
X  a`5B24`5D = '\0';
X `20
X  if (current == 1)
X    fprintf (fp,"%s  PURITY_%s an undetermined \%\%  Pure from 0 questions.\
Vn",a,user);
X  else
X    fprintf (fp,"%s  PURITY_%s %d\%\%  Pure from %d questions.\n",a,user,c,c
Vurrent-1);
X`7D
X
Xvoid savestupid ()
X
X`7B
X  int a;
X  int b;
X  FILE *sp;                 /* file pointer for save file    */
X
X  a = current*9;
X  b = (current-yes+1)*7;
X  sp = fopen (savefile,"w");
X  fprintf (sp,"%d\n%d\n",a,b);
X  fclose (sp);
X`7D
X
Xvoid del ()
X
X`7B
X  $DESCRIPTOR(file_d,savefile);
X  lib$delete_file(&file_d);
X`7D
X
Xint retrieve (int *current, int *yes)
X
X`7B
X  int a;
X  int b;
X  FILE *rp;                 /* file pointer for save file    */
X `20
X  rp = fopen (savefile,"r");
X
X  if (rp != NULL)
X  `7B
X    fscanf(rp,"%d\n",&a);
X    fscanf(rp,"%d\n",&b);
X    fclose (rp);
X    del ();
X
X    *current = (a/9)-1;
X    *yes = (*current-(b/7))+2;
X    return True;
X  `7D
X  return False;
X`7D
X
Xint echo ()
X
X`7B
X  int a;
X  int b;
X  a = True;
X
X  printf ("\033<\033`5B1;1f\033`5BJ\033`5B0m\n");
X  printf ("\033`5B9;30HDo you want results");
X  printf ("\033`5B10;30Hprinted to screen??");
X
X  while (b != SMG$K_TRM_CTRLM )
X  `7B
X  if (b == SMG$K_TRM_UP ) ++a;
X  if (b == SMG$K_TRM_DOWN) --a;
X  if (a < 0) a = 1;
X  if (a > 1) a = 0;
X  if (a == 1)
X   `7B
X    printf ("\033`5B13;30HNO,I'm too perverse");
X    printf ("\033`5B7m\033`5B12;30H  Yeah, why not?   \033`5B0m");
X   `7D
X  if (a == 0)
X   `7B
X    printf ("\033`5B12;30H  Yeah, why not?   ");
X    printf ("\033`5B7m\033`5B13;30HNO,I'm too perverse\033`5B0m");
X   `7D
X  smg$read_keystroke (&keyboard,&b);
X  `7D
X  return a;
X`7D
X
Xvoid sendjob()
X
X`7B
X  int a;
X  int b;
X  $DESCRIPTOR(crosby_d,"xprint/print_site=crosby $1$dua12:`5Btemp.masmummy.p
Vurity`5Dpurity.test");
X  $DESCRIPTOR(baldy_d,"xprint/print_site=baldy $1$dua12:`5Btemp.masmummy.pur
Vity`5Dpurity.test");
X  $DESCRIPTOR(ellicott_d,"xprint/print_site=ellicott $1$dua12:`5Btemp.masmum
Vmy.purity`5Dpurity.test");
X  $DESCRIPTOR(bell_d,"xprint/print_site=bell $1$dua12:`5Btemp.masmummy.purit
Vy`5Dpurity.test");
X
X  a = 0;
X  b = 0;
X  printf ("\033<\033`5B1;1f\033`5BJ\033`5B0m\n");
X  printf ("\033`5B10;25HTo which of the listed sites?");
X  printf ("\033`5B11;20H1) Crosby  2) Baldy  3) Ellicott  4) Bell");
X  printf ("\033`5B13;33HChoice? \033`5B1m");
X
X  while (!((b == SMG$K_TRM_ONE) `7C`7C (b == SMG$K_TRM_TWO) `7C`7C (b == SMG
V$K_TRM_THREE )`7C`7C (b == SMG$K_TRM_FOUR )))
X    smg$read_keystroke (&keyboard,&b);
X  if (b == SMG$K_TRM_ONE)
X  `7B
X    printf ("Crosby");
X    printf ("\033`5B0m");
X    printf ("\033`5B15;24HBe sure to pick up your printout!");
X    lib$do_command(&crosby_d);
X  `7D
X  if (b == SMG$K_TRM_TWO)
X  `7B
X    printf ("Baldy");
X    printf ("\033`5B0m");
X    printf ("\033`5B15;24HBe sure to pick up your printout!");
X    lib$do_command(&baldy_d);
X  `7D
X  if (b == SMG$K_TRM_THREE)
X  `7B
X    printf ("Ellicott");
X    printf ("\033`5B0m");
X    printf ("\033`5B15;24HBe sure to pick up your printout!");
X    lib$do_command(&ellicott_d);
X  `7D
X  if (b == SMG$K_TRM_FOUR)
X  `7B
X    printf ("Bell");
X    printf ("\033`5B0m");
X    printf ("\033`5B15;24HBe sure to pick up your printout!");
X    lib$do_command(&bell_d);
X  `7D
X`7D
X
Xint accept ()
X
X`7B
X  int a;
X  char b`5B132`5D;
X  int c;
X  char d;
X  FILE *dp;                 /* file pointer for disclaimer file      */
X
X  printf ("\033`5B1;24r");
X  b`5B1`5D = '1';               /* itialize b to something other than \0 */
X  dp = fopen (disclaim,"r");
X  if ( dp != NULL)
X  `7B
X    for ( c=1 ; c<100 ; c++)
X    `7B
X      fgets (b,132,dp);
X      printf (b);
X    `7D
X  `7D
X `20
X  printf ("\033`5BH\033`5BJ");
X  printf ("Do you want to \033`5B1mQ\033`5B0muit or \033`5B1mC\033`5B0montin
Vue ?   ");
X  while (!(d == 'q' `7C`7C d == 'Q' `7C`7C d == 'c' `7C`7C d == 'C'))
X    smg$read_keystroke (&keyboard,&d);
X  if (d == 'q' `7C`7C d =='Q' )
X  `7B
X    printf ("Quit");
X    return False;
X  `7D
X  printf ("Continue");
X  return True;
X`7D
X
Xmain ()
X`7B
X  smg$create_virtual_keyboard (&keyboard);
X  fp = fopen (datafile,"r");
X  quit = False;
X  current = 0;
X  yes = 0;
X  if (accept ())
X  `7B
X      show = echo ();
X      if (!(retrieve (&current,&yes)))
X        line == head();
X      else
X      `7B
X        printf ("\033<\033`5B1;1f\033`5BJ\033`5B0m\n");
X        printf ("\033`5B2;1H Resuming where you left off....\n");
X        printf (" __________________________________________________________
V____________________\n");
X        printf ("\033`5B4;24r");
X      `7D`20
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-