games-request@tekred.TEK.COM (10/26/87)
Submitted by: Thomas M Johnson <john1233%csd4.milw.wisc.edu@csd1.milw.wisc.edu>
Comp.sources.games: Volume 2, Issue 63
Archive-name: dating
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: Makefile Questions README bbase date.doc.v1 date.doc.v2
# date.v1.p date.v2.p getw.c getw.h
# Wrapped by billr@tekred on Mon Oct 26 11:38:38 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"Makefile\"
else
echo shar: Extracting \"Makefile\" \(336 characters\)
sed "s/^X//" >Makefile <<'END_OF_Makefile'
X# crude makefile for datingame (none supplied with original source)
X#
Xv1: date.v1.p
X pc date.v1.p
X mv a.out datingame
X touch v1
X
Xinstall-v1: v1
X touch database
X
Xv2: getw.o date.v1.p
X pc date.v2.p getw.o
X mv a.out datingame
X touch v2
X
Xinstall-v2: v2
X mkdir .date
X cp Questions .date/Questions
X cp bbase .date/bbase
X touch .date/database
END_OF_Makefile
if test 336 -ne `wc -c <Makefile`; then
echo shar: \"Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f Questions -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"Questions\"
else
echo shar: Extracting \"Questions\" \(6299 characters\)
sed "s/^X//" >Questions <<'END_OF_Questions'
X
XWhat is your weight?
X A. Under 100 lbs.
X B. 100 lbs-125 lbs.
X C. 125 lbs-140 lbs.
X D. 140 lbs-160 lbs.
X E. 160 lbs-180 lbs.
X F. 180 lbs-200 lbs.
X G. 200 lbs-220 lbs.
X H. Over 220 lbs.
X
Xh
XWhat is your height?
X A. Under 5 ft.
X B. 5 ft-5 ft. 4 in.
X C. 5 ft. 4 in. - 5 ft. 7 in.
X D. 5 ft. 7 in. - 5 ft. 10 in.
X E. 5 ft. 10 in. - 6 ft.
X F. Over 6 ft.
X
Xf
XWhat is the color of your hair?
X A. Brown
X B. Black
X C. Red
X D. Blond
X E. Gray
X F. Auburn
X G. Bald
X
Xg
XWhat is the color of your eyes?
X A. Brown
X B. Blue
X C. Hazel
X D. Green
X E. Violet
X F. Gray
X
Xf
XHow old are you?
X A. Less than 18
X B. 18-20
X C. 21-23
X D. 24-27
X E. 28-32
X F. 33-40
X G. 41-50
X H. Over 50
X
Xh
XHow do you dress?
X A. Preppie
X B. Casual
X C. Jeans and T-shirt
X D. Sleezy
X E. Dressy
X F. Conservatively
X
Xf
XWhat is your ethnic group?
X A. White
X B. Black
X C. Hispanic
X D. Oriental/Asian
X E. Indian
X
Xe
XWhat is your status?
X A. Single
X B. Separated/Divorced
X C. Widow/Widower
X D. Married
X
Xd
XHow do you rate yourself on a
Xscale from 1 to 10?
X A. Under 5
X B. 5 to 6
X C. 7 to 8
X D. 9 to 10
X E. Over 10
X
Xe
XGiven the following choices
XWhat is your favorite hobby?
X A. Sports K. Camping
X B. Dancing L. Computers / Electronics
X C. Concerts M. Politics
X D. Travel N. Listening to music
X E. Theater O. Photography
X F. Reading P. Arts and Crafts
X G. Domestics Q. Cooking
X H. Sex R. Dancing
X I. Watching television S. Cars / Mechanics
X J. Shopping T. Work / Career
X
Xt
XWhat is your favorite kind of music?
X A. Rock K. Opera
X B. Pop L. Folk
X C. New Wave M. Country and Western
X D. Punk N. Gospel
X E. Soul O. Electronic
X F. Disco P. Movie Sound Tracks
X G. Jazz Q. Easy listening
X H. Rhythm and Blues R. Rap
X I. Classical S. Heavy Metal
X J. Classic Rock
X
Xs
XHow would you feel recieving
Xan obscene phone call?
X A. I would like it.
X B. It would be interesting.
X C. I would not like it.
X
Xc
XWhich of the following comes closest
Xto describing your social life?
X A. I hang out with a large crowd.
X B. I have a small circle of close friends.
X C. I have many acquaintances but not many
X truly close friends.
X
Xc
XWhere would you prefer to live?
X A. Country
X B. City
X C. Suburbs
X
Xc
XCurrent education level
X A. Did not finish high school
X B. High school
X C. Some college / Technical training
X D. Currently working toward 4 year degree
X E. 4 year degree
X F. Masters degree
X G. Doctorate degree
X
Xg
XI consider myself
X A. Shy
X B. Outgoing
X C. Not shy but not outgoing either
X
Xc
XWhat is your favorite social activity?
X A. Going to bars
X B. Cruising
X C. Concerts/Theater
X D. Going to the movies
X E. Watching T.V.
X F. Partying
X G. Dancing
X H. Playing BINGO
X I. Gab sessions
X
Xi
XAre you emotionally open?
X A. I am warm and expressive
X B. I can usually express my feelings but sometimes
X I hold back
X C. I find it hard to express myself
X D. I never say what I feel
X
Xd
XWhat is most important to you in a person?
X A. Kindness and understanding
X B. Assurance and decisiveness
X C. Money and power
X D. Education and intelligence
X E. Honesty and openness and trust
X F. Looks and build
X
Xf
XHow important is sex to you?
X A. I can take it or leave it
X B. Sex is a natural part of a relationship
X C. Sex is a requirement in relationships
X D. I have never had sex
X
Xd
XHow important is it to love your sex partner?
X A. Love is very important
X B. Love is semi-important
X C. Love is not important
X D. Love and sex? I never confuse the two
X
Xd
XWhy are you using the Date-A-Base?
X A. To find new friends
X B. To find a steady lover
X C. To find a one night stand
X D. Just looking
X
Xd
XI would rather watch a movie
X A. In the theater
X B. On Television
X C. In a 25 cent booth with a stack of quarters
X
Xc
XIf you are truly in love
X A. Both should be faithful
X B. Fooling around with others is alright
X C. I pleed the 5th ammenddment
X
Xc
XHow ambitious are you?
X A. Very ambitious
X B. Moderately ambitious
X C. Laid back
X D. Very lazy
X
Xd
XDo you smoke?
X A. Do not smoke
X B. Light cigarette smoker
X C. Heavy cigarette smoker
X
Xc
XWith regards to the telephone..
X A. I enjoy talking on the phone
X B. I hate the phone
X C. I use the phone only when necessary
X
Xc
XWhat kind of television do you watch?
X A. Sitcoms
X B. Soaps
X C. Variety
X D. Movies
X E. Sports
X F. News
X G. Public TV
X H. Do not watch TV
X
Xh
XWhich goal is most important to you?
X A. Wealth
X B. Knowledge
X C. Serenity
X D. Power
X E. Popularity
X F. Respectability
X
Xf
XWhat kind of books do you like to read?
X A. Science fiction
X B. Classics
X C. Non-fiction / Technical
X D. Mysteries
X E. Poetry
X F. Novels
X G. Romance
X
Xg
XWhen are usually the most alert?
X A. Morning
X B. Afternoon
X C. Early evening
X D. Late evening
X
Xd
XHow would you describe your upbringing?
X A. Strict
X B. Average
X C. Permissive
X D. Indifferent
X
Xd
XHow often do you usually date?
X A. Almost every night
X B. Once a week
X C. A few times a week
X D. A few times a month
X E. Irregularly
X F. Never
X
Xf
XWhat would your ideal relationship be?
X A. Exciting
X B. Platonic
X C. Varied
X D. Casual
X E. Physical
X F. Exclusive
X G. Intense
X H. Sensible
X I. Intimate
X J. Long-lived
X K. Undemanding
X L. Considerate
X M. Romantic
X
Xm
XWhat sort of people are you most comfotable with?
X A. Outdoors types
X B. Artists
X C. Average folks
X D. Intellectuals
X E. Working people
X F. Professionals
X G. Cultured individuals
X
Xg
XWho do you live with?
X A. Alone
X B. With roomate
X C. With lover
X D. With parents
X E. With spouse
X
Xe
XHonestly - how is your body?
X A. I am in top shape
X B. I am in shape
X C. I go to the gym occasionally
X D. Do not ask me about my body
X
Xd
XI consider myself...
X A. A real knockout - guaranteed
X B. Very good looking
X C. I am pretty cute
X D. Average / Not bad
X E. I make up for it in other ways
X
Xe
XWould you be interested in meeting your match?
X A. Yes
X B. No
X C. Only if I am contacted first
X
Xc
X
END_OF_Questions
if test 6299 -ne `wc -c <Questions`; then
echo shar: \"Questions\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f README -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(486 characters\)
sed "s/^X//" >README <<'END_OF_README'
XWell, here is a computer dating service I have just finished.
XIf features a 40 question questionaire and matches people up by
Xpercentage with MOTOS. There are 2 versions available.
X
XVersion 1.0: requires only a Pascal Compiler
X
XVersion 2.0: designed to run under unix 4.3 bsd. It has all the options
X of version 1 plus more. It may run under other versions
X of unix, if your system supports the features it requires.
X
X
X Tom
X john1233@csd4.milw.wisc.edu
END_OF_README
if test 486 -ne `wc -c <README`; then
echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f bbase -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"bbase\"
else
echo shar: Extracting \"bbase\" \(3800 characters\)
sed "s/^X//" >bbase <<'END_OF_bbase'
Xweight:
Xh
XUnder 100 lbs.
X100 lbs-125 lbs.
X125 lbs-140 lbs.
X140 lbs-160 lbs.
X160 lbs-180 lbs.
X180 lbs-200 lbs.
X200 lbs-220 lbs.
XOver 220 lbs.
Xheight:
Xf
XUnder 5 ft.
X5 ft-5 ft. 4 in.
X5 ft. 4 in. - 5 ft. 7 in.
X5 ft. 7 in. - 5 ft. 10 in.
X5 ft. 10 in. - 6 ft.
XOver 6 ft.
Xhair:
Xg
XBrown
XBlack
XRed
XBlond
XGray
XAuburn
XBald
Xeyes:
Xf
XBrown
XBlue
XHazel
XGreen
XViolet
XGray
Xage:
Xh
XLess than 18
X18-20
X21-23
X24-27
X28-32
X33-40
X41-50
XOver 50
Xdress:
Xf
XPreppie
XCasual
XJeans and T-shirt
XSleezy
XDressy
XConservatively
Xethnic:
Xe
XWhite
XBlack
XHispanic
XOriental/Asian
XIndian
Xstatus:
Xd
XSingle
XSeparated/Divorced
XWidow/Widower
XMarried
Xrate:
Xe
XUnder 5
X5 to 6
X7 to 8
X9 to 10
XOver 10
Xhobby:
Xt
XSports
XDancing
XConcerts
XTravel
XTheater
XReading
XDomestics
XSex
XWatching television
XShopping
XCamping
XComputers / Electronics
XPolitics
XListening to music
XPhotography
XArts and Crafts
XCooking
XDancing
XCars / Mechanics
XWork / Career
Xmusic:
Xs
XRock
XPop
XNew Wave
XPunk
XSoul
XDisco
XJazz
XRhythm and Blues
XClassical
XOpera
XFolk
XCountry and Western
XGospel
XElectronic
XMovie Sound Tracks
XEasy listening
XRap
XHeavy Metal
XClassic Rock
Xobscene phone call:
Xc
XI would like it.
XIt would be interesting.
XI would not like it.
Xfriends:
Xc
XI hang out with a large crowd.
XI have a small circle of close friends.
Xmany acquaintances not close friends.
Xlive:
Xc
XCountry
XCity
XSuburbs
Xeducation:
Xg
XDid not finish high school
XHigh school
XSome college / Technical training
XCurrently working toward 4 year degree
X4 year degree
XMasters degree
XDoctorate degree
Xshy:
Xc
XShy
XOutgoing
XNot shy but not outgoing either
Xsocial life:
Xi
XGoing to bars
XCruising
XConcerts/Theater
XGoing to the movies
XWatching T.V.
XPartying
XDancing
XPlaying BINGO
XGab sessions
Xopeness:
Xd
XI am warm and expressive
XUsually express, sometimes hold back
XI find it hard to express myself
XI never say what I feel
Ximportant in a person:
Xf
XKindness and understanding
XAssurance and decisiveness
XMoney and power
XEducation and intelligence
XHonesty and openness and trust
XLooks and build
Xsex:
Xd
XI can take it or leave it
XSex is a natural part of a relationship
XSex is a requirement in relationships
XI have never had sex
Xlove sex partner:
Xd
XLove is very important
XLove is semi-important
XLove is not important
XLove and sex? I never confuse the two
Xwhy here:
Xd
XTo find new friends
XTo find a steady lover
XTo find a one night stand
XJust looking
Xmovie:
Xc
XIn the theater
XOn Television
XIn a 25 cent booth with a stack of quarters
Xtruly in love:
Xc
XBoth should be faithful
XFooling around with others is alright
XI pleed the 5th ammenddment
Xambition:
Xd
XVery ambitious
XModerately ambitious
XLaid back
XVery lazy
Xsmoke:
Xc
XDo not smoke
XLight smoker
XHeavy smoker
Xtelephone:
Xc
XI enjoy talking on the phone
XI hate the phone
XI use the phone only when necessary
Xtelevision:
Xh
XSitcoms
XSoaps
XVariety
XMovies
XSports
XNews
XPublic TV
XDo not watch TV
Xgoal:
Xf
XWealth
XKnowledge
XSerenity
XPower
XPopularity
XRespectability
Xbooks:
Xg
XScience fiction
XClassics
XNon-fiction / Technical
XMysteries
XPoetry
XNovels
XRomance
Xalert:
Xd
XMorning
XAfternoon
XEarly evening
XLate evening
Xupbringing:
Xd
XStrict
XAverage
XPermissive
XIndifferent
Xdate:
Xf
XAlmost every night
XOnce a week
XA few times a week
XA few times a month
XIrregularly
XNever
Xideal relationship:
Xm
XExciting
XPlatonic
XVaried
XCasual
XPhysical
XExclusive
XIntense
XSensible
XIntimate
XLong-lived
XUndemanding
XConsiderate
XRomantic
Xpeople comfortable with:
Xg
XOutdoors types
XArtists
XAverage folks
XIntellectuals
XWorking people
XProfessionals
XCultured individuals
Xlive with:
Xe
XAlone
XWith roommate
XWith lover
XWith parents
XWith spouse
Xbody:
Xd
XI am in top shape
XI am in shape
XI go the gym occasionally
XDo not ask me about my body
Xconsider myself:
Xe
XA real knockout - guaranteed
XVery good looking
XPretty cute
XAverage / not bad
XMake up for it in other ways
Xmeeting match:
Xc
XYes
XNo
XOnly if I am contacted first
X
END_OF_bbase
if test 3800 -ne `wc -c <bbase`; then
echo shar: \"bbase\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f date.doc.v1 -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"date.doc.v1\"
else
echo shar: Extracting \"date.doc.v1\" \(2026 characters\)
sed "s/^X//" >date.doc.v1 <<'END_OF_date.doc.v1'
X Docs for Date-A-Base version 1
X
XFirst you must have the following files in your directory called:
X bbase
X Questions
X
Xthen you must also issue:
X touch database
X
XThe actual program file is
X date.v1.p
X
XTo run the programs you must
X
Xpc date.v1.p
X
Xyou can then ReMove date.v1.p
Xand rename the a.out file.
X
Xso here are the commands:
X touch database
X pc date.v1.p
X mv a.out datingame
X
XJust type 'datingame' and away it goes.
X
XThere is a copyright on the program. This doesn't mean you can't give it
Xaway or modify it. It only means that my name is to appear in the 'bye'
Xprocedure and the commented header.
X
XTechnical stuff
X---------------
X
XVersion 1.0 of the Date-A-Base is designed to be 100% standard Pascal.
XThis is so it can be run on any machine with a Pascal compiler.
X
XVersion 2.0 is available with extra options. 2 of these options will
Xprobably work on most machines but they were left out on purpose.
X
XFirst, the use of the wallclock function. Wallclock returns the number
Xof seconds since Jan. 1, 1970. I have left references to the wallclock in
X(* comments *). If you computer has a wallclock or functionally similar
Xfunction, just erase the (* comments *) and if needed, rename the function.
X
XAlso, you can change the reset() and rewrite() functions to point to
Xdifferent directories. Version 2.0 uses a .date directory to
Xhold the database, bbase and Questions files.
XTo to this you must:
X mkdir .date
X cp Questions .date/Questions
X cp bbase .date/bbase
X touch .date/database
X
Xyou must also change all the reset() and rewite() functions.
XEx. reset(database, '.date/database');
X
XThe actual name of the file must be in single quotes.
X
XThe wallclock and reset(pathname) rewrite(pathname) are no available
Xto all versions of Pascal. Check before you try them.
X
X
X Thomas M. Johnson
X
X john1233@csd4.milw.wisc.edu
X or
X tommyj@lakesys
END_OF_date.doc.v1
if test 2026 -ne `wc -c <date.doc.v1`; then
echo shar: \"date.doc.v1\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f date.doc.v2 -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"date.doc.v2\"
else
echo shar: Extracting \"date.doc.v2\" \(1566 characters\)
sed "s/^X//" >date.doc.v2 <<'END_OF_date.doc.v2'
X Docs for Date-A-Base version 2
X
XFirst you must copy the following files into a directory called:
X .date
X
XThe files are: bbase
X Questions
X
Xthen into this directory you must also issue:
X touch database
X
XThe actual program files are
X date.v2.p
X getw.c
X getw.h
X
XTo run the programs you must
X
Xcc -c getw.c
X
XThen:
X
Xpc date.v2.p getw.o
X
Xyou can then ReMove date.v2.p, getw.c, getw.o, date.o and getw.h
Xand rename the a.out file.
X
Xso here are the commands:
X mkdir .date
X cp Questions .date/Questions
X cp bbase .date/bbase
X touch .date/database
X cc -c getw.c
X pc date.v2.p getw.o
X mv a.out datingame
X
XJust type 'datingame' and away it goes.
X
XThere is a copyright on the program. This doesn't mean you can't give it
Xaway or modify it. It only means that my name is to appear in the 'bye'
Xprocedure and the commented header.
X
XTechnical stuff
X---------------
X
XThe differences between version 1.0 and 2.0 are:
X
XIn 2.0, the user no longer has to enter his own name. His login name
Xis automatically placed in the Date-A-Base.
X
XVersion 2.0 also support the wallclock function. The wallclock function
Xreturns the number of seconds that have passed since Jan. 1, 1970.
XThis may be called something else on your system, so you can modify the
Xsource to any function that is functionally the same.
X
XIn version 2.0 the data files (database, bbase and Questions) are places
Xin a hidden directory (.date). These can be moved to any directory as
Xlong as you change the 'reset' commands.
X
X Thomas M. Johnson
X
END_OF_date.doc.v2
if test 1566 -ne `wc -c <date.doc.v2`; then
echo shar: \"date.doc.v2\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f date.v1.p -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"date.v1.p\"
else
echo shar: Extracting \"date.v1.p\" \(14598 characters\)
sed "s/^X//" >date.v1.p <<'END_OF_date.v1.p'
Xprogram date(input, output, Questions, database, bbase);
X
X(*
X Date-A-Base version 1.0
X by
X Thomas M. Johnson
X
X john1233@csd4.milw.wisc.edu
X or
X tommyj@lakesys
X
X files used:
X Questions - holds the questionaire
X database - all people registered with the Date-A-Base
X and their information
X bbase - data used by brouse command.
X
X(c) 1987 Thomas M. Johnson *)
X
X
X
X
Xconst
X NUMOFQUESTIONS = 49;
X STRINGLENGTH = 20;
X ONE = 1;
X LOW = 'a';
X
Xtype
X string = packed array [ONE..STRINGLENGTH] of char;
X answerarray = packed array [ONE..NUMOFQUESTIONS] of char;
X userp = ^ usertype;
X usertype =
X record
X login: string;
X passwd: string;
X sex: char;
X timeson: integer;
X answers: answerarray;
X(* laston: integer; *)
X next: userp
X end;
X
Xvar
X Questions: text;
X database: file of usertype;
X head: userp;
X static: usertype;
X bbase: text;
X continue: boolean;
X
X
X
X function cstrings(var string1: answerarray; string2: answerarray): real;
X
X (* The function cstrings takes 2 strings and compares them.
X cstrings then returns the percent identical the strings are.
X The strings are compared letter for letter and must be in the
X same place in the string. *)
X
X
X var
X counter: integer;
X percent: integer;
X
X begin
X percent := 0;
X
X for counter := ONE to NUMOFQUESTIONS do
X if string1[counter] = string2[counter] then
X percent := percent + 1;
X cstrings := percent / NUMOFQUESTIONS * 100
X end; { cstrings }
X
X function yesNo: boolean;
X
X const
X yes = 'y';
X no = 'n';
X
X var
X ch: char;
X
X begin
X repeat
X write(output, ' (y/n) ');
X readln(input, ch)
X until (ch = yes) or (ch = no);
X yesNo := ch = yes
X
X end; { yesNo }
X
X
X
X function getanswer(ubound: char): char;
X
X (* The function getanswer reads in a character and checks to see
X if it is in the range of lobound to ubound. If it isn't, then the
X user is reprompted. *)
X
X
X var
X tempchar: char;
X charindex: char;
X
X begin
X repeat
X writeln(output);
X
X for charindex := LOW to ubound do
X write(output, charindex);
X
X writeln(output);
X write(output, 'Your choice: ');
X readln(input, tempchar)
X until (tempchar >= LOW) and (tempchar <= ubound);
X
X writeln(output);
X getanswer := tempchar
X end; { getanswer }
X
X
X procedure readstring(var tempstring: string);
X
X (* read a string from standard input. the string must have
X a length of 2 or greater or it is invalid. *)
X
X
X const
X init = 0;
X inc = 1;
X blank = ' ';
X
X var
X ch: char;
X length: integer;
X
X begin
X repeat
X tempstring := blank;
X length := init;
X while not eoln(input) do begin
X read(input, ch);
X length := length + inc;
X tempstring[length] := ch
X end;
X readln(input)
X until length > 1
X
X end; { readstring }
X
X procedure readint(var sum: integer);
X
X (* read in a string from standard input and convert to an
X integer. *)
X
X
X const
X init = 0;
X inc = 1;
X base = 10;
X intlow = '0';
X inthigh = '9';
X
X var
X i: integer;
X done: boolean;
X hold: string;
X
X begin
X i := inc;
X done := false;
X sum := init;
X readstring(hold);
X while (i <= STRINGLENGTH) and not done do
X if (hold[i] < intlow) or (hold[i] > inthigh) then
X done := true
X else begin
X sum := sum * base + (ord(hold[i]) - ord(intlow));
X if sum > maxint then
X done := true
X else
X i := i + inc
X end
X end; { readint }
X
X
X
X procedure printques(var quests: answerarray);
X
X (* prints the questions from the file Questions.
X the question file is set up like:
X
X The question
X the answers
X .
X .
X .
X .
X ^G (up limit)
X
X then ^G is just a marker to signify where the answers end.
X low limit is usually and 'a'
X up limit the the last answer
X
X *)
X
X var
X ch: char;
X uplimit: char;
X chset: set of char;
X i: integer;
X
X begin
X reset(Questions);
X i := 1;
X chset := ['A'..'Z', 'a'..'z', '0'..'9', '?', '.', ' ', '-', '/'];
X ch := ' ';
X while not eof(Questions) do begin
X while not eoln(Questions) do begin
X read(Questions, ch);
X if ch in chset then
X write(output, ch)
X else begin
X readln(Questions, uplimit);
X quests[i] := getanswer(uplimit);
X i := i + 1
X end
X end;
X readln(Questions);
X writeln(output)
X end
X end; { printques }
X
X function Search(lookfor: string; var hisrec: usertype): boolean;
X
X (* scan the linked list to find a match between the string lookfor
X and the .login field. If there is a match, a true is returned with
X the record of that person. Otherwise a false is returned *)
X
X
X var
X found: boolean;
X temptr: userp;
X
X begin
X found := false;
X temptr := head;
X
X while (temptr <> nil) and not found do
X if temptr^.login = lookfor then begin
X hisrec := temptr^;
X found := true
X end else
X temptr := temptr^.next;
X
X Search := found
X end; { Search }
X
X
X procedure newUser;
X
X (* if the person in not in the linked list, add him *)
X
X
X const
X male = 'm';
X female = 'f';
X inc = 1;
X
X var
X ch: char;
X node: userp;
X
X
X
X begin
X writeln(output, 'To use the Date-A-Base you will have to answer a');
X writeln(output, 'personal questionaire. Your answers to all the');
X writeln(output, 'questions will available for anyone registered');
X writeln(output, 'in the Date-A-Base to look at.');
X writeln(output);
X writeln(output, 'Do you want to continue? ');
X continue := yesNo;
X if continue then begin
X repeat
X writeln(output);
X writeln(output, 'What sex are you? m or f');
X readln(input, ch)
X until (ch = male) or (ch = female);
X static.sex := ch;
X with static do begin
X timeson := inc
X end;
X
X(* laston := wallclock *)
X printques(static.answers);
X writeln(output);
X writeln(output, 'What password do you want to use?');
X writeln(output, 'IMPORTANT: Make this different than');
X writeln(output, 'your login password.');
X readstring(static.passwd);
X new(node);
X node^ := static;
X node^.next := head;
X head := node
X end
X end; { newUser }
X
X
X
X
X procedure oldUser;
X
X (* the person is already registered. Just get his data. *)
X
X
X const
X
X
X inc = 1;
X var
X password: string;
X temptr: userp;
X found: boolean;
X
X
X begin
X repeat
X writeln(output);
X writeln(output, 'What is your password?');
X write(output, '? ');
X readstring(password);
X if password <> static.passwd then
X writeln(output, 'Sorry, thats not right!')
X until password = static.passwd;
X with static do begin
X timeson := timeson + inc
X end;
X
X(* laston := wallclock *)
X temptr := head;
X found := false;
X while (temptr <> nil) and not found do
X if temptr^.login = static.login then begin
X static.next := temptr^.next;
X temptr^ := static;
X found := true
X end else
X temptr := temptr^.next
X
X end; { oldUser }
X
X
X
X procedure initialize;
X
X (* This procedure reads in the current file with all registered
X users into a linked list. *)
X
X
X var
X node: userp;
X name: string;
X
X begin
X head := nil;
X reset(database);
X while not eof(database) do begin
X new(node);
X read(database, node^);
X node^.next := head;
X head := node
X end; (* while *)
X writeln(output);
X writeln(output);
X writeln(output, ' The');
X writeln(output, ' Date-A-Base');
X writeln(output);
X writeln(output);
X writeln(output, ' The computerized dating service.');
X writeln(output);
X writeln(output);
X writeln(output);
X writeln(output, 'What is your login name?');
X write(output, '? ');
X continue := true;
X readstring(name);
X static.login := name;
X if not Search(name, static) then
X newUser
X else
X oldUser
X
X
X end; { initialize }
X
X procedure savedata;
X
X (* save the linked list in the file database *)
X
X
X var
X pointer: userp;
X
X
X begin
X rewrite(database);
X pointer := head;
X if pointer <> nil then
X while pointer^.next <> nil do begin
X write(database, pointer^);
X pointer := pointer^.next
X end;
X write(database, pointer^)
X
X end; { savedata }
X
X procedure answer;
X
X (* answer the questionaire again *)
X
X
X var
X check: boolean;
X temptr: userp;
X found: boolean;
X
X begin
X writeln(output);
X writeln(output, 'Are you sure you want to answer all the');
X writeln(output, 'questions again?');
X check := yesNo;
X if check then
X printques(static.answers);
X temptr := head;
X found := false;
X while (temptr <> nil) and not found do
X if temptr^.login = static.login then begin
X static.next := temptr^.next;
X temptr^ := static;
X found := true
X end else
X temptr := temptr^.next
X
X end; { answer }
X
X procedure brouse;
X
X (* give a quick scan of someone else's questionaire. the data for
X the brouse is in bbase. Data looks like:
X
X the topic
X the maximum answer
X answer
X .
X .
X .
X
X *)
X
X
X const
X(* clicks = 86400; *)
X (* number of seconds in a day *)
X low = 'a';
X field = 3;
X zero = 0;
X marker = 15;
X
X var
X who: string;
X index: char;
X ch: char;
X max: char;
X i: integer;
X j: integer;
X(* time: integer; *)
X rec: usertype;
X
X begin
X writeln(output, 'Whose questionare do you want to brouse?');
X write(output, '? ');
X readstring(who);
X if Search(who, rec) then begin
X
X i := ONE;
X j := ONE;
X reset(bbase);
X writeln(output);
X write(output, 'Name: ');
X writeln(output, rec.login);
X write(output, 'Used the Date-A-Base ');
X write(output, rec.timeson: field);
X if rec.timeson = ONE then
X writeln(output, ' time. ')
X else
X writeln(output, ' times. ');
X
X write(output, 'Last used the Date-A-Base: ');
X (* time := wallclock - rec.laston;
X time := time div clicks;
X if time = zero then
X writeln(output, 'today.');
X if time = ONE then
X writeln(output, 'yesterday.');
X if time > ONE then begin
X write(output, time: field);
X writeln(output, ' days ago.')
X end; *)
X
X writeln(output);
X while not eof(bbase) do begin
X while not eoln(bbase) do begin
X read(bbase, ch);
X write(output, ch)
X end;
X readln(bbase);
X readln(bbase, max);
X for index := low to max do begin
X if index = rec.answers[i] then begin
X while not eoln(bbase) do begin
X read(bbase, ch);
X write(output, ch)
X end;
X writeln(output);
X readln(bbase)
X end else
X readln(bbase)
X end;
X if j = marker then begin
X repeat
X writeln(output);
X writeln(output, 'Continue? ')
X until yesNo;
X j := zero;
X writeln(output)
X end;
X j := j + ONE;
X i := i + ONE
X end
X end else
X writeln(output, 'Sorry that person is not registered!');
X
X repeat
X writeln(output);
X writeln(output, 'Return to the menu? ')
X until yesNo
X end; { brouse }
X
X procedure delete;
X
X (* delete a person from the linked list *)
X
X var
X found: boolean;
X pointer: userp;
X
X begin
X found := false;
X writeln(output, 'Are you sure you want to delete yourself?');
X if yesNo then begin
X pointer := head;
X if pointer^.login = static.login then begin
X head := pointer^.next;
X dispose(pointer)
X end else
X while not found do
X while pointer^.next <> nil do
X if pointer^.next^.login = static.login then begin
X pointer^.next := pointer^.next^.next;
X dispose(pointer^.next);
X found := true
X end else
X pointer := pointer^.next
X end
X end; { delete }
X
X
X
X
X
X procedure match;
X
X (* find a match between 2 people. scans the whole linked list
X and reports all matches greater than the amount entered. *)
X
X
X const
X loginfield = 47;
X perfield = 5;
X dplaces = 1;
X namefield = 33;
X low = 9;
X high = 100;
X
X
X var
X pointer: userp;
X percent: integer;
X per: real;
X found: boolean;
X
X
X begin
X pointer := head;
X writeln(output);
X writeln(output, 'What is the lowest percent match that');
X writeln(output, 'you want to see? ');
X repeat
X write(output, ' (10 - 99) ');
X
X readint(percent)
X until (percent > low) and (percent < high);
X
X
X writeln(output);
X write(output, '%': perfield);
X writeln(output, 'name': namefield);
X writeln(output, '----------------------------------------------------');
X
X found := false;
X if pointer <> nil then
X while pointer <> nil do begin
X per := cstrings(static.answers, pointer^.answers);
X if (per >= percent) and (static.sex <> pointer^.sex) then begin
X found := true;
X writeln(output);
X write(output, per: perfield: dplaces);
X write(output, '%');
X writeln(output, pointer^.login: loginfield)
X end;
X pointer := pointer^.next
X end;
X if not found then begin
X writeln(output);
X writeln(output, 'Sorry, no matches found today. Try again later.')
X end;
X repeat
X writeln(output);
X writeln(output);
X writeln(output, 'Are you ready to continue?')
X until yesNo
X
X end; { match }
X
X
X procedure bye;
X
X begin
X writeln(output);
X writeln(output, 'Thank you for using the Date-A-Base');
X writeln(output, 'Hope to hear from you again soon.');
X writeln(output);
X writeln(output);
X writeln(output);
X writeln(output);
X writeln(output);
X writeln(output,'(c) 1987 Thomas M. Johnson');
X writeln(output)
X end; { bye }
X
X
X procedure menu;
X
X (* The procedure menu is the programs main menu. It prints the
X commands and executes the proper subroutine based on the users
X choice. *)
X
X
X const
X
X lastchoice = 'e';
X var
X choice: char;
X
X begin
X repeat
X writeln(output);
X writeln(output);
X writeln(output, ' Menu');
X writeln(output, ' ----');
X writeln(output);
X writeln(output, ' [a] answer questionare');
X writeln(output, ' [b] brouse questionare');
X writeln(output, ' [c] make a match');
X writeln(output, ' [d] delete your questionare');
X writeln(output);
X writeln(output, ' [e] quit');
X
X choice := getanswer(lastchoice);
X
X case choice of
X 'a':
X answer;
X 'b':
X brouse;
X 'c':
X match;
X 'd':
X delete;
X 'e':
X writeln(output)
X end
X until choice = lastchoice
X
X end; { menu }
X
Xbegin
X initialize;
X if continue then begin
X menu;
X savedata
X end;
X bye
Xend. { date }
X
END_OF_date.v1.p
if test 14598 -ne `wc -c <date.v1.p`; then
echo shar: \"date.v1.p\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f date.v2.p -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"date.v2.p\"
else
echo shar: Extracting \"date.v2.p\" \(15266 characters\)
sed "s/^X//" >date.v2.p <<'END_OF_date.v2.p'
Xprogram date(input, output, Questions, database, bbase);
X
X(*
X Date-A-Base version 2.0
X by
X Thomas M. Johnson
X
X john1233@csd4.milw.wisc.edu
X or
X tommyj@lakesys
X
X file used:
X .date/Questions - holds the questionaire
X .date/database - all the people registered with the Date-A-Base
X and their information
X .date/bbase - data used by the brouse command.
X
X version 2.0 must have getw.h in the same directory. This routine
X allows Pascal to access the C getlogin() function.
X
X
X(c) 1987 Thomas M. Johnson *)
X
X
X
X
Xconst
X NUMOFQUESTIONS = 49;
X STRINGLENGTH = 20;
X ONE = 1;
X LOW = 'a';
X
Xtype
X string = packed array [ONE..STRINGLENGTH] of char;
X answerarray = packed array [ONE..NUMOFQUESTIONS] of char;
X userp = ^ usertype;
X usertype =
X record
X login: string;
X sex: char;
X timeson: integer;
X answers: answerarray;
X laston: integer;
X next: userp
X end;
X
Xvar
X Questions: text;
X database: file of usertype;
X head: userp;
X static: usertype;
X bbase: text;
X continue: boolean;
X
X#include "getw.h"
X
X function cstrings(var string1: answerarray; string2: answerarray): real;
X
X (* The function cstrings takes 2 strings and compares them.
X cstrings then returns the percent identical the strings are.
X The strings are compared letter for letter and must be in the
X same place in the string. *)
X
X
X var
X counter: integer;
X percent: integer;
X
X begin
X percent := 0;
X
X for counter := ONE to NUMOFQUESTIONS do
X if string1[counter] = string2[counter] then
X percent := percent + 1;
X cstrings := percent / NUMOFQUESTIONS * 100
X end; { cstrings }
X
X function yesNo: boolean;
X
X const
X yes = 'y';
X no = 'n';
X
X var
X ch: char;
X
X begin
X repeat
X write(output, ' (y/n) ');
X readln(input, ch)
X until (ch = yes) or (ch = no);
X yesNo := ch = yes
X end; { yesNo }
X
X
X
X
X function getanswer(ubound: char): char;
X
X (* The function getanswer reads in a character and checks to see
X if it is in the range of lobound to ubound. If it isn't, then the
X user is reprompted. *)
X
X
X var
X tempchar: char;
X charindex: char;
X
X begin
X repeat
X writeln(output);
X
X for charindex := LOW to ubound do
X write(output, charindex);
X
X writeln(output);
X write(output, 'Your choice: ');
X readln(input, tempchar)
X until (tempchar >= LOW) and (tempchar <= ubound);
X
X writeln(output);
X getanswer := tempchar
X end; { getanswer }
X
X procedure clearstring(var tempstring: string);
X
X const
X
X blank = ' ';
X var
X i: integer;
X
X begin
X for i := ONE to STRINGLENGTH do
X tempstring[i] := blank
X end; { clearstring }
X
X
X
X procedure readstring(var tempstring: string);
X
X (* read a string from standard input. the string must have
X a length of 2 or greater or it is invalid. *)
X
X
X const
X init = 0;
X inc = 1;
X
X var
X ch: char;
X length: integer;
X
X begin
X repeat
X clearstring(tempstring);
X length := init;
X while not eoln(input) do begin
X read(input, ch);
X length := length + inc;
X tempstring[length] := ch
X end;
X readln(input)
X until length > 1
X
X end; { readstring }
X
X procedure readint(var sum: integer);
X
X (* read in a string from standard input and convert to an
X integer. *)
X
X
X const
X init = 0;
X inc = 1;
X base = 10;
X intlow = '0';
X inthigh = '9';
X
X var
X i: integer;
X done: boolean;
X hold: string;
X
X begin
X i := inc;
X done := false;
X sum := init;
X readstring(hold);
X while (i <= STRINGLENGTH) and not done do
X if (hold[i] < intlow) or (hold[i] > inthigh) then
X done := true
X else begin
X sum := sum * base + (ord(hold[i]) - ord(intlow));
X if sum > maxint then
X done := true
X else
X i := i + inc
X end
X end; { readint }
X
X
X
X procedure printques(var quests: answerarray);
X
X (* prints the questions from the file Questions.
X the question file is set up like:
X
X The question
X the answers
X .
X .
X .
X .
X ^G (up limit)
X
X then ^G is just a marker to signify where the answers end.
X low limit is usually and 'a'
X up limit the the last answer
X
X *)
X
X var
X ch: char;
X uplimit: char;
X chset: set of char;
X i: integer;
X
X begin
X reset(Questions,'.date/Questions');
X i := 1;
X chset := ['A'..'Z', 'a'..'z', '0'..'9', '?', '.', ' ', '-', '/'];
X ch := ' ';
X while not eof(Questions) do begin
X while not eoln(Questions) do begin
X read(Questions, ch);
X if ch in chset then
X write(output, ch)
X else begin
X readln(Questions, uplimit);
X quests[i] := getanswer(uplimit);
X i := i + 1
X end
X end;
X readln(Questions);
X writeln(output)
X end
X end; { printques }
X
X
X function test(string1: string; string2: string): boolean;
X
X (* I was having a lot of trouble converting the Search function from
X version 1 to this version because the strings were coming out
X of the getw.h external procedure 1 character longer than all the
X other strings. So the comparison was always false. This function
X takes the place of that comparison.
X *)
X
X var
X same: boolean;
X i: integer;
X chset: set of char;
X
X
X begin
X i := ONE;
X same := true;
X chset := ['a'..'z', 'A'..'Z', '0'..'9'];
X
X while (string1[i] in chset) and (string2[i] in chset) and same do begin
X same := string1[i] = string2[i];
X i := i + ONE
X end;
X
X test := same;
X if string1[i + ONE] <> string2[i + ONE] then
X test := false
X end; { test }
X
X
X
X
X function Search(lookfor: string; var hisrec: usertype): boolean;
X
X (* scan the linked list to find a match between the string lookfor
X and the .login field. If there is a match, a true is returned with
X the record of that person. Otherwise a false is returned *)
X
X
X var
X found: boolean;
X temptr: userp;
X
X begin
X found := false;
X temptr := head;
X
X while (temptr <> nil) and not found do
X if test(temptr^.login, lookfor) then begin
X hisrec := temptr^;
X found := true
X end else
X temptr := temptr^.next;
X
X Search := found
X end; { Search }
X
X
X procedure newUser;
X
X (* if the person in not in the linked list, add him *)
X
X
X const
X male = 'm';
X female = 'f';
X inc = 1;
X
X var
X ch: char;
X node: userp;
X
X
X
X begin
X writeln(output, 'To use the Date-A-Base you will have to answer a');
X writeln(output, 'personal questionaire. Your answers to all the');
X writeln(output, 'questions will be available for anyone registered');
X writeln(output, 'in the Date-A-Base to look at.');
X writeln(output);
X writeln(output, 'Do you want to continue? ');
X continue := yesNo;
X
X if continue then begin
X repeat
X writeln(output);
X writeln(output, 'What sex are you? m or f');
X readln(input, ch)
X until (ch = male) or (ch = female);
X static.sex := ch;
X with static do begin
X timeson := inc;
X laston := wallclock
X end;
X printques(static.answers);
X writeln(output);
X new(node);
X node^ := static;
X node^.next := head;
X head := node
X end
X end; { newUser }
X
X
X
X
X procedure oldUser;
X
X (* the person is already registered. Just get his data. *)
X
X
X const
X
X
X inc = 1;
X var
X temptr: userp;
X found: boolean;
X
X
X begin
X writeln(output);
X with static do begin
X timeson := timeson + inc;
X laston := wallclock
X end;
X temptr := head;
X found := false;
X while (temptr <> nil) and not found do
X if temptr^.login = static.login then begin
X static.next := temptr^.next;
X temptr^ := static;
X found := true
X end else
X temptr := temptr^.next
X
X end; { oldUser }
X
X procedure initialize;
X
X (* This procedure reads in the current file with all registered
X users into a linked list. *)
X
X
X const
X
X copymax = 15;
X var
X node: userp;
X name: string;
X i: integer;
X
X begin
X head := nil;
X reset(database,'.date/database');
X while not eof(database) do begin
X new(node);
X read(database, node^);
X node^.next := head;
X head := node
X end;
X writeln(output);
X writeln(output);
X writeln(output, ' The');
X writeln(output, ' Date-A-Base');
X writeln(output);
X writeln(output);
X writeln(output, ' The computerized dating service.');
X writeln(output);
X writeln(output);
X writeln(output);
X continue := true;
X clearstring(name);
X getwh(name);
X for i := ONE to copymax do
X static.login[i] := name[i];
X if not Search(name, static) then
X newUser
X else
X oldUser
X
X
X end; { initialize }
X
X procedure savedata;
X
X (* save the linked list in the file database *)
X
X
X var
X pointer: userp;
X
X
X begin
X rewrite(database,'.date/database');
X pointer := head;
X if pointer <> nil then
X while pointer^.next <> nil do begin
X write(database, pointer^);
X pointer := pointer^.next
X end;
X write(database, pointer^)
X
X end; { savedata }
X
X procedure answer;
X
X (* answer the questionaire again *)
X
X
X var
X check: boolean;
X temptr: userp;
X found: boolean;
X
X begin
X writeln(output);
X writeln(output, 'Are you sure you want to answer all the');
X writeln(output, 'questions again?');
X check := yesNo;
X if check then
X printques(static.answers);
X temptr := head;
X found := false;
X while (temptr <> nil) and not found do
X if temptr^.login = static.login then begin
X static.next := temptr^.next;
X temptr^ := static;
X found := true
X end else
X temptr := temptr^.next
X
X end; { answer }
X
X procedure brouse;
X
X (* give a quick scan of someone else's questionaire. the data for
X the brouse is in bbase. Data looks like:
X
X the topic
X the maximum answer
X answer
X .
X .
X .
X
X *)
X
X
X const
X low = 'a';
X clicks = 86400; (* number of seconds in a day *)
X field = 3;
X zero = 0;
X marker = 15;
X
X var
X who: string;
X index: char;
X ch: char;
X max: char;
X i: integer;
X j: integer;
X time: integer;
X rec: usertype;
X
X begin
X writeln(output, 'Whose questionare do you want to brouse?');
X write(output, '? ');
X readstring(who);
X
X
X
X if Search(who, rec) then begin
X
X i := ONE;
X j := ONE;
X reset(bbase,'.date/bbase');
X writeln(output);
X write(output, 'Name: ');
X writeln(output, rec.login);
X write(output, 'Used the Date-A-Base ');
X write(output, rec.timeson: field);
X if rec.timeson = ONE then
X writeln(output, ' time. ')
X else
X writeln(output, ' times. ');
X
X write(output, 'Last used the Date-A-Base: ');
X time := wallclock - rec.laston;
X time := time div clicks;
X if time = zero then
X writeln(output, 'today.');
X if time = ONE then
X writeln(output, 'yesterday.');
X if time > ONE then begin
X write(output, time: field);
X writeln(output, ' days ago.')
X end;
X
X writeln(output);
X while not eof(bbase) do begin
X while not eoln(bbase) do begin
X read(bbase, ch);
X write(output, ch)
X end;
X readln(bbase);
X readln(bbase, max);
X for index := low to max do begin
X if index = rec.answers[i] then begin
X while not eoln(bbase) do begin
X read(bbase, ch);
X write(output, ch)
X end;
X writeln(output);
X readln(bbase)
X end else
X readln(bbase)
X end;
X if j = marker then begin
X repeat
X writeln(output);
X writeln(output, 'Continue? ')
X until yesNo;
X j := zero;
X writeln(output)
X end;
X j := j + ONE;
X i := i + ONE
X end (* while not eof *)
X end else
X writeln(output, 'Sorry that person is not registered!');
X
X repeat
X writeln(output);
X writeln(output, 'Return to the menu? ')
X until yesNo
X end; { brouse }
X
X procedure delete;
X
X (* delete a person from the linked list *)
X
X var
X found: boolean;
X pointer: userp;
X
X begin
X found := false;
X writeln(output, 'Are you sure you want to delete yourself?');
X if yesNo then begin
X pointer := head;
X if pointer^.login = static.login then begin
X head := pointer^.next;
X dispose(pointer)
X end else
X while not found do
X while pointer^.next <> nil do
X if pointer^.next^.login = static.login then begin
X pointer^.next := pointer^.next^.next;
X dispose(pointer^.next);
X found := true
X end else
X pointer := pointer^.next
X end
X end; { delete }
X
X
X
X
X
X procedure match;
X
X (* find a match between 2 people. scans the whole linked list
X and reports all matches greater than the amount entered. *)
X
X
X const
X loginfield = 47;
X perfield = 5;
X dplaces = 0;
X namefield = 33;
X low = 9;
X high = 100;
X
X
X var
X pointer: userp;
X percent: integer;
X per: real;
X found: boolean;
X
X
X begin
X pointer := head;
X writeln(output);
X writeln(output, 'What is the lowest percent match that');
X writeln(output, 'you want to see? ');
X repeat
X write(output, ' (10 - 99) ');
X
X readint(percent)
X until (percent > low) and (percent < high);
X
X
X writeln(output);
X write(output, '%': perfield);
X writeln(output, 'name': namefield);
X writeln(output, '----------------------------------------------------');
X
X found := false;
X if pointer <> nil then
X while pointer <> nil do begin
X per := cstrings(static.answers, pointer^.answers);
X if (per >= percent) and (static.sex <> pointer^.sex) then begin
X found := true;
X writeln(output);
X write(output, per: perfield: dplaces);
X write(output, '%');
X writeln(output, pointer^.login: loginfield)
X end;
X pointer := pointer^.next
X end;
X if not found then begin
X writeln(output);
X writeln(output, 'Sorry, no matches found today. Try again later.')
X end;
X repeat
X writeln(output);
X writeln(output);
X writeln(output, 'Are you ready to continue?')
X until yesNo
X
X end; { match }
X
X procedure bye;
X
X begin
X writeln(output);
X writeln(output, 'Thank you for using the Date-A-Base');
X writeln(output, 'Hope to hear from you again soon.');
X writeln(output);
X writeln(output);
X writeln(output);
X writeln(output);
X writeln(output);
X writeln(output,'(c) 1987 Thomas M. Johnson');
X writeln(output)
X end; { bye }
X
X
X procedure menu;
X
X (* The procedure menu is the programs main menu. It prints the
X commands and executes the proper subroutine based on the users
X choice. *)
X
X
X const
X
X lastchoice = 'e';
X var
X choice: char;
X
X begin
X repeat
X writeln(output);
X writeln(output);
X writeln(output, ' Menu');
X writeln(output, ' ----');
X writeln(output);
X writeln(output, ' [a] answer questionare');
X writeln(output, ' [b] brouse questionare');
X writeln(output, ' [c] make a match');
X writeln(output, ' [d] delete your questionare');
X writeln(output);
X writeln(output, ' [e] quit');
X
X choice := getanswer(lastchoice);
X
X case choice of
X 'a':
X answer;
X 'b':
X brouse;
X 'c':
X match;
X 'd':
X delete;
X 'e':
X writeln(output)
X end
X until choice = lastchoice
X
X end; { menu }
X
Xbegin
X initialize;
X if continue then begin
X menu;
X savedata
X end;
X bye
Xend. { date }
X
END_OF_date.v2.p
if test 15266 -ne `wc -c <date.v2.p`; then
echo shar: \"date.v2.p\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f getw.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"getw.c\"
else
echo shar: Extracting \"getw.c\" \(83 characters\)
sed "s/^X//" >getw.c <<'END_OF_getw.c'
Xextern getwh();
X
Xchar *
Xgetwh() {
Xchar *getlogin();
X return (getlogin());
X }
X
END_OF_getw.c
if test 83 -ne `wc -c <getw.c`; then
echo shar: \"getw.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f getw.h -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"getw.h\"
else
echo shar: Extracting \"getw.h\" \(42 characters\)
sed "s/^X//" >getw.h <<'END_OF_getw.h'
Xprocedure getwh(var w: string); external;
END_OF_getw.h
if test 42 -ne `wc -c <getw.h`; then
echo shar: \"getw.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0