Shareware Overload/ShartewareOverload.cdr/games/wgtloss.zip/WGTLOSS.BAS

BASIC Source File | 1987-09-26 | 17KB | 321 lines

1000 REM The Dieter's Guide to Weight Loss During Sex
1010 '
1020 REM For the IBM PC/XT written in BASICA
1030 '
1040 GOSUB 3740
1050 DASH$=STRING$(80,45)
1055 LN$=STRING$(10,42)
1060 '
1070 '=====================================================================
1080 '
1090 SCREEN 0,1: COLOR 7,0,0: WIDTH 80: CLS
1100 LOCATE 1,18:  PRINT "THE DIETER'S GUIDE TO WEIGHT LOSS DURING SEX"
1110 LOCATE 2,1:   PRINT DASH$
1120 LOCATE 5,15:  PRINT "How much weight do we lose during sex?"
1130 LOCATE 7,10:  PRINT "The diet literature explains calories burned while"
1140 LOCATE 8,10:  PRINT "jogging, playing tennis or golfing, but similar"
1150 LOCATE 9,10:  PRINT "information concerning sexual activity has, until"
1160 LOCATE 10,10: PRINT "now, been unavailable.  Yet, a survey of"
1170 LOCATE 11,10: PRINT "260,000,000 Americans indicates that 98 percent"
1180 LOCATE 12,10: PRINT "devote more time and effort to sex than to jogging,"
1190 LOCATE 13,10: PRINT "tennis, or golf and we felt that the time was right"
1200 LOCATE 14,10: PRINT "for a new type of calorie counter."
1210 GOSUB 3870
1220 '
1230 '=====================================================================
1240 '
1250 SCREEN 0,1: COLOR 0,2,2: CLS
1260 LOCATE 1,24:  PRINT LN$ " EXAMPLES: " LN$
1270 LOCATE 2,1:   PRINT DASH$
1280 LOCATE 5,10:  PRINT "1 hour of intensive foreplay BURNS OFF 1 slice (large)"
1290 LOCATE 6,10:  PRINT "          chocolate cake."
1300 LOCATE 9,10:  PRINT "26 minutes of nonstop lovemaking BURNS OFF 2 slices"
1310 LOCATE 10,10: PRINT "          of pizza with extra cheese and mushrooms."
1320 LOCATE 12,10: PRINT "53 minutes of kissing partner BURNS OFF 1"
1330 LOCATE 13,10: PRINT "          cheeseburger with 14 french fries."
1340 LOCATE 15,10: PRINT "53 minutes of kissing yourself BURNS OFF 1"
1350 LOCATE 16,10: PRINT "          Thanksgiving Turkey with all the trimmin's."
1360 GOSUB 3870
1370 '
1380 '=====================================================================
1390 '
1400 SCREEN 0,1: COLOR 0,2,2: CLS
1410 LOCATE 1,18:  PRINT LN$ " PREPARING THE BEDROOM " LN$
1420 GOSUB 3930
1430 LOCATE 8,5:   PRINT "Includes setting the snooze alarm and dimming the lights............42"
1440 GOSUB 3870
1450 '
1460 '=====================================================================
1470 '
1480 SCREEN 0,1: COLOR 0,3,3: CLS
1490 LOCATE 1,12:  PRINT LN$ " ADDITIONAL LAST-MINUTE PREPARATIONS " LN$
1500 GOSUB 3930
1510 LOCATE 10,5:  PRINT "Hiding the sex manual................................................3"
1520 LOCATE 12,5:  PRINT "Decanting the wine...................................................4"
1530 LOCATE 14,5:  PRINT "Without a corkscrew................................................268"
1540 GOSUB 3870
1550 '
1560 '=====================================================================
1570 '
1580 SCREEN 0,1: COLOR 0,3,3: CLS
1590 LOCATE 1,18:  PRINT LN$ " MAKING THE FIRST MOVE " LN$
1600 GOSUB 3930
1610 LOCATE 10,5:  PRINT "If you are shy......................................................15"
1620 LOCATE 12,5:  PRINT "If you are anxious..................................................45"
1630 LOCATE 14,5:  PRINT "If you beg.........................................................100"
1640 GOSUB 3870
1650 '
1660 '=====================================================================
1670 '
1680 SCREEN 0,1: COLOR 7,4,4: CLS
1690 LOCATE 1,21:  PRINT LN$ " SEDUCING PARTNER " LN$
1700 GOSUB 3930
1710 LOCATE 10,5:  PRINT "If you are rich (CASH)...............................................5"
1720 LOCATE 11,5:  PRINT "                (CREDIT CARD).......................................15"
1730 LOCATE 13,5:  PRINT "If you are poor....................................................200"
1740 GOSUB 3870
1750 '
1760 '=====================================================================
1770 '
1780 SCREEN 0,1: COLOR 7,4,4: CLS
1790 LOCATE 1,19:  PRINT LN$ " INITIAL BODY CONTACT " LN$
1800 GOSUB 3930
1810 LOCATE 10,5:  PRINT "Fumbling.............................................................4"
1820 LOCATE 12,5:  PRINT "Casually rummaging around............................................7"
1830 LOCATE 14,5:  PRINT "Seriously rummaging around..........................................42"
1840 GOSUB 3870
1850 '
1860 '====================================================================
1870 '
1880 SCREEN 0,1: COLOR 7,8,8: CLS
1890 LOCATE 1,21:  PRINT LN$ " REMOVING CLOTHES " LN$
1900 GOSUB 3930
1910 LOCATE 10,5:  PRINT "With partner's consent..............................................12"
1920 LOCATE 12,5:  PRINT "Without partner's consent...........................................12"
1930 LOCATE 14,5:  PRINT "Removing socks by violently shaking feet...........................418"
1940 GOSUB 3870
1950 '
1960 '====================================================================
1970 '
1980 SCREEN 0,1: COLOR 7,8,8: CLS
1990 LOCATE 1,24:  PRINT LN$ " AROUSAL AND STIMULATION " LN$
2000 GOSUB 3930
2010 LOCATE 10,5:  PRINT "Blowing in partner's ear using mouth.................................9"
2020 LOCATE 12,5:  PRINT "Using blow dryer  (low setting)......................................2"
2030 LOCATE 14,5:  PRINT "Blowing in your own ear..........................................2,512"
2040 GOSUB 3870
2050 '
2060 '====================================================================
2070 '
2080 SCREEN 0,1: COLOR 0,3,3: CLS
2090 LOCATE 1,5:   PRINT LN$ " DISAPPOINTMENT (after seeing partner undressed) " LN$
2100 GOSUB 3930
2110 LOCATE 10,5:  PRINT "Partner looks better with cloths on.................................19"
2120 LOCATE 12,5:  PRINT "Partner wears corrective underwear..................................15"
2130 LOCATE 14,5:  PRINT "Partner turns out to be of wrong sex...............................100"
2140 LOCATE 16,5:  PRINT "You don't mind.....................................................1/4"
2150 LOCATE 18,5:  PRINT "Partner wearing elevated socks......................................60"
2160 GOSUB 3870
2170 '
2180 '====================================================================
2190 '
2200 SCREEN 0,1: COLOR 7,5,5: CLS
2210 LOCATE 1,15:  PRINT LN$ " DOING IT FOR THE FIRST TIME " LN$
2220 GOSUB 3930
2230 LOCATE 10,5:  PRINT "Fumbling around......................................................4"
2240 LOCATE 12,5:  PRINT "Desperately trying to put something somewhere.......................18"
2250 LOCATE 14,5:  PRINT "Completely missing.................................................126"
2260 GOSUB 3870
2270 '
2280 '====================================================================
2290 '
2300 SCREEN 0,1: COLOR 7,1,1: CLS
2310 LOCATE 1,24:  PRINT LN$ " POSITIONS " LN$
2320 GOSUB 3930
2330 LOCATE 8,5:   PRINT "ITALIAN: Man on top, woman on bottom................................26"
2340 LOCATE 10,5:  PRINT "GERMAN: Facing each other, but in different beds....................48"
2350 LOCATE 12,5:  PRINT "ENGLISH: Woman on top, man in hiding................................15"
2360 LOCATE 14,5:  PRINT "AMERICAN: Both on top............................................1,236"
2370 GOSUB 3870
2380 '
2390 '====================================================================
2400 '
2410 SCREEN 0,1: COLOR 7,1,1: CLS
2420 LOCATE 1,23:  PRINT LN$ " AFFLICTIONS " LN$
2430 GOSUB 3930
2440 LOCATE 8,5:   PRINT "Leg cramp...........................................................36"
2450 LOCATE 10,5:  PRINT "Making believe you don't have one..................................612"
2460 LOCATE 12,5:  PRINT "Sneezing - during intercourse........................................7"
2470 LOCATE 13,5:  PRINT "           during orgasm...........................................855"
2480 GOSUB 3870
2490 '
2500 '====================================================================
2510 '
2520 SCREEN 0,1: COLOR 0,7,7: CLS
2530 LOCATE 1,20:  PRINT LN$ " ASSORTED ACCIDENTS " LN$
2540 GOSUB 3930
2550 LOCATE 8,5:   PRINT "Toupee slips off - If partner knew you were wearing one..............6"
2560 LOCATE 9,5:   PRINT "                   If partner didn't know...........................72"
2570 LOCATE 11,5:  PRINT "Extinguishing cigarette - in ashtray.................................1"
2580 LOCATE 12,5:  PRINT "                          in mattress...............................17"
2590 LOCATE 13,5:  PRINT "                          in partner's leg.........................133"
2600 LOCATE 15,5:  PRINT "Calling partner by wrong name.......................................50"
2610 GOSUB 3870
2620 '
2630 '====================================================================
2640 '
2650 SCREEN 0,1: COLOR 0,7,7: CLS
2660 LOCATE 1,17:  PRINT LN$ " ORGASMIC INTENSITY SCALE " LN$
2670 GOSUB 3930
2680 LOCATE 8,5:   PRINT "Expression didn't change...........................................1/2"
2690 LOCATE 9,5:   PRINT "Room turned Purple...................................................4"
2700 LOCATE 10,5:  PRINT "Shoes flew off......................................................15"
2710 LOCATE 11,5:  PRINT "Earth moved.........................................................30"
2720 LOCATE 12,5:  PRINT "Face turned purple..................................................78"
2730 LOCATE 13,5:  PRINT "Moaning in Turkish.................................................506"
2740 LOCATE 14,5:  PRINT "If earth actually moved......................................1,246,864"
2750 GOSUB 3870
2760 '
2770 '====================================================================
2780 '
2790 SCREEN 0,1: COLOR 7,1,1: CLS
2800 LOCATE 1,15:  PRINT LN$ " THINGS OFTEN SAID AFTER SEX " LN$
2810 GOSUB 3930
2820 LOCATE 8,5:   PRINT "I'm so grateful......................................................5"
2830 LOCATE 10,5:  PRINT "It must have been something we ate...................................5"
2840 LOCATE 12,5:  PRINT "Was it good for you?.................................................5"
2850 LOCATE 14,5:  PRINT "Are you finished?....................................................5"
2860 LOCATE 16,5:  PRINT "The ceiling needs painting...........................................5"
2870 GOSUB 3870
2880 '
2890 '====================================================================
2900 '
2910 SCREEN 0,1: COLOR 7,1,1: CLS
2920 LOCATE 1,23:  PRINT LN$ " TRYING AGAIN " LN$
2930 GOSUB 3930
2940 LOCATE 8,5:   PRINT "If woman is ready....................................................5"
2950 LOCATE 10,5:  PRINT "If man is not......................................................156"
2960 GOSUB 3870
2970 '
2980 '====================================================================
2990 '
3000 SCREEN 0,1: COLOR 0,2,2: CLS
3010 LOCATE 1,13:  PRINT LN$ " ROLLING OVER AND GOING TO SLEEP " LN$
3020 GOSUB 3930
3030 LOCATE 8,5:   PRINT "After sex...........................................................18"
3040 LOCATE 10,5:  PRINT "During sex.........................................................546"
3050 LOCATE 12,5:  PRINT "While parking the car..............................................212"
3060 GOSUB 3870
3070 '
3080 '====================================================================
3090 '
3100 SCREEN 0,1: COLOR 0,2,2: CLS
3110 LOCATE 1,26:  PRINT LN$ " SLEEP " LN$
3120 GOSUB 3930
3130 LOCATE 8,5:   PRINT "Real.................................................................5"
3140 LOCATE 10,5:  PRINT "Faked (a good way to avoid a sex-crazed partner)....................72"
3150 GOSUB 3870
3160 '
3170 '====================================================================
3180 '
3190 SCREEN 0,1: COLOR 0,3,3: CLS
3200 LOCATE 1,18:  PRINT LN$ " TAKING A BATH TOGETHER " LN$
3210 GOSUB 3930
3220 LOCATE 8,5:   PRINT "In a tub.............................................................5"
3230 LOCATE 10,5:  PRINT "In a sink..........................................................152"
3240 LOCATE 12,5:  PRINT "In a Jacuzzi sink...............................................15,262"
3250 GOSUB 3870
3260 '
3270 '====================================================================
3280 '
3290 SCREEN 0,1: COLOR 0,3,3: CLS
3300 LOCATE 1,22:  PRINT LN$ " MAKING THE BED " LN$
3310 GOSUB 3930
3320 LOCATE 8,5:   PRINT "With partner still in it............................................44"
3330 LOCATE 9,5:  PRINT "       (indicates either a neatness obsession, a severe optic"
3340 LOCATE 10,5:  PRINT "        disorder or a partner who is very tired"
3350 GOSUB 3870
3360 '
3370 '====================================================================
3380 '
3390 SCREEN 0,1: COLOR 7,4,4: CLS
3400 LOCATE 1,20:  PRINT LN$ " KEEPING A JOURNAL " LN$
3410 LOCATE 10,10: PRINT "Maintaining your own record of sexual activity will be helpful for"
3420 LOCATE 11,5:  PRINT "keeping track of weight loss.  You needn't go into detail; just"
3430 LOCATE 12,5:  PRINT "list the activity and the number of calories burned."
3440 LOCATE 14,10: PRINT "A typical entry in a woman's journal, (for example) for a"
3450 LOCATE 15,5:  PRINT "pleasent, low-key sexual experience might read as follows:"
3460 GOSUB 3870
3470 '
3480 '====================================================================
3490 '
3500 SCREEN 0,1: COLOR 7,4,4: CLS
3510 LOCATE 1,25:  PRINT "JUNE 1, 1985: Sex with Bill"
3520 GOSUB 3930
3530 LOCATE 6,5:  PRINT "Explaining how......................................................12"
3540 LOCATE 7,5:  PRINT "Suggesting something different.......................................3"
3550 LOCATE 8,5:  PRINT "Calming a terrified Bill............................................40"
3560 LOCATE 9,5:  PRINT "Encouraging him to at least take off his socks.......................8"
3570 LOCATE 10,5: PRINT "Foreplay (a little of this, a little of that).......................56"
3580 LOCATE 11,5: PRINT "Intercourse:"
3590 LOCATE 12,5: PRINT "Standing position...................................................22"
3600 LOCATE 13,5: PRINT "Holding Bill up.....................................................10"
3610 LOCATE 14,5: PRINT "Urging him on........................................................5"
3620 LOCATE 15,5:  PRINT "Orgasm........................................................(not sure)"
3630 LOCATE 16,5:  PRINT "Thanking Bill........................................................2"
3640 LOCATE 17,5:  PRINT "Waving bye-bye.......................................................3"
3650 LOCATE 19,5:  PRINT "TOTAL TIME: 6 MINUTES"
3660 LOCATE 20,5:  PRINT "(taxi waiting)"
3670 LOCATE 21,5:  PRINT "TOTAL CALORIES BURNED..............................................161"
3680 GOSUB 3870
3690 '
3700 CLS:SYSTEM
3710 '
3720 '====================================================================
3730 '
3740 KEY OFF: SCREEN 0,1: COLOR 15,0,0: WIDTH 40: CLS
3750 COLOR 10,0:  LOCATE 8,9: PRINT CHR$(213)+STRING$(24,205)+CHR$(184)
3760 LOCATE 9,9:  PRINT CHR$(179)+" WEIGHT LOSS DURING SEX "+CHR$(179)
3770 LOCATE 10,9: PRINT CHR$(179)+"      RATED  PG-13      "+CHR$(179)
3780 LOCATE 11,9: PRINT CHR$(179)+"   FOR FAMILY VIEWING   "+CHR$(179)
3790 LOCATE 12,9: PRINT CHR$(212)+STRING$(24,205)+CHR$(190)
3800 COLOR 14,0:  LOCATE 14,9: PRINT "CDR Matt Costarakis,  USNR"
3810 COLOR 13,0:  LOCATE 23,9: PRINT "Press ANY key to continue"
3820 ANS$=INKEY$: IF ANS$="" THEN 3820
3830 RETURN
3840 '
3850 '====================================================================
3860 '
3870 LOCATE 22,1: PRINT; DASH$
3880 LOCATE 23,26: PRINT "Press ANY key to continue "
3890 ANS$=INKEY$: IF ANS$="" THEN 3890
3900 RETURN
3910 '
3920 '====================================================================
3930 LOCATE 2,1:  PRINT DASH$
3940 LOCATE 4,15: PRINT "ACTIVITY"; TAB(70); "CALORIES"
3950 LOCATE 5,71: PRINT "BURNED"
3960 RETURN
3970 '
3980 REM ************************************************
3990 REM *                                              *
4000 REM * The Dieter's Guide to Weight Loss During Sex *
4010 REM *                                              *
4020 REM *                      by                      *
4030 REM *          CDR Matt Costarakis, USNR           *
4040 REM *                Project Staff                 *
4050 REM *      75th Anniversary of Naval Aviation      *
4060 REM *      Bldg 159E   Rm 519                      *
4070 REM *      Washington Navy Yard Annex              *
4080 REM *      Washington,  DC   20374-1595            *
4090 REM *                                              *
4100 REM *      COMMERCIAL (202)-475-2739/40/41/42      *
4110 REM *      AUTOVON     335-2739 thru 42            *
4120 REM *                                              *
4130 REM *            FILE "WGTLOSS.BAS"                *
4140 REM *                                              *
4150 REM *    rev. 1.1                   30 OCT 1985    *
4160 REM *                                              *
4170 REM *                                              *
4180 REM ************************************************