PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #47)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “PC-SIG SAMPLER #1”
A virtual potpouri of programs, which range from games and musical
programs to utilities that calculate electric usage and dump pictures
to your printer. The CASTLE program, an adventure in a wizard's
castle, is an old favorite. And the FINPAK package is a collection of
useful financial aids.
System Requirements: Some programs require color graphics.
How to Start: To read DOCfiles, enter TYPE filename.ext and press
<ENTER>. To run an EXE program, just type its name and press <ENTER>.
For instructions on running BASIC programs, please refer to the
GETTING STARTED section in this catalog.
File Descriptions:
CASTLE DOC Documentation for CASTLE game
CASTLE BAS Wizards castle game from July/Aug, Recreational Computing
XMAS BAS Plays Christmas song
CHRONSET BAS Sets Hayes stack chronograph
DISRTN EXE Disk file utility - undeletes and recovers lost sectors
COMCHRON BAS Program to read Hayes stack chronograph
SORT-BLK BAS Sorts fixed length record files
PLOT BAS Creates plots on color display
MAILLIST BAS Mailing list program
KILLNULL BAS Removes nulls from sequential files
GDUMP2 BAS Graphics dump program
GDUMP1 BAS Graphics dump program
FINPAK BAS Package of 20 financial programs
ELECTRIC BAS Computes electric usage
NORMAL-Z BAS BASIC program
COMPRESS BAS BASIC program
CASTLE.BAS
1000 REM *****************************************************
1005 REM * *
1010 REM * WIZARD'S CASTLE GAME FROM JULY/AUGUST 1980 *
1015 REM * ISSUE OF RECREATIONAL COMPUTING MAGAZINE *
1020 REM * WRITTEN FOR EXIDY SORCERER BY JOSEPH R. POWER *
1025 REM * MODIFIED FOR HEATH MICROSOFT BASIC BY J.F.STETSON *
1030 REM * *
1035 REM *****************************************************
1040 DEFINT A-Z
1045 DIM C$(34),I$(34),R$(4),W$(8),E$(8)
1050 DIM L(512),C(3,4),T(8),O(3),R(3)
1055 DEF FNA(Q)=1+INT(RND(1)*Q)
1060 DEF FNB(Q)=Q+8*((Q=9)-(Q=0))
1065 DEF FNC(Q)=-Q*(Q<19)-18*(Q>18)
1070 DEF FND(Q)=64*(Q-1)+8*(X-1)+Y
1075 DEF FNE(Q)=Q+100*(Q>99)
1080 Y$="** PLEASE ANSWER YES OR NO"
1085 NG=0
1090 REM
1095 REM INITIALIZE ARRAYS
1100 REM
1105 NG=NG+1
1110 Q=RND(1)
1115 RESTORE
1120 FOR Q=1 TO 34
1125 READ C$(Q),I$(Q)
1130 NEXT Q
1135 FOR Q=1 TO 512
1140 L(Q)=101
1145 NEXT Q
1150 FOR Q=1 TO 8
1155 READ W$(Q),E$(Q)
1160 NEXT Q
1165 FOR Q=1 TO 4
1170 READ R$(Q)
1175 NEXT Q
1180 IF NG > 1 GOTO 1250
1185 PRINT CHR$(27);"E"
1190 GOSUB 5375
1195 PRINT TAB(16);"* * * THE WIZARD'S CASTLE * * *"
1200 PRINT
1205 GOSUB 5375
1210 PRINT "MANY CYCLES AGO, IN THE KINGDOM OF N'DIC, THE GNOMIC"
1215 PRINT "WIZARD ZOT FORGED HIS GREAT *ORB OF POWER*. HE SOON"
1220 PRINT "VANISHED, LEAVING BEHIND HIS VAST SUBTERRANEAN CASTLE"
1225 PRINT "FILLED WITH ESURIENT MONSTERS, FABULOUS TREASURES, AND"
1230 PRINT "THE INCREDIBLE *ORB OF ZOT*. FROM THAT TIME HENCE, MANY"
1235 PRINT "A BOLD YOUTH HAS VENTURED INTO THE WIZARD'S CASTLE. AS"
1240 PRINT "OF NOW, *NONE* HAS EVER EMERGED VICTORIOUSLY! BEWARE!!"
1245 PRINT
1250 X=1 : Y=4
1255 L(FND(1))=2
1260 FOR Z=1 TO 7
1265 FOR Q1=1 TO 2
1270 Q=104
1275 GOSUB 5285
1280 L(FND(Z+1))=103
1285 NEXT Q1
1290 NEXT Z
1295 FOR Z=1 TO 8
1300 FOR Q=113 TO 124
1305 GOSUB 5285
1310 NEXT Q
1315 FOR Q1=1 TO 3
1320 FOR Q=105 TO 112
1325 GOSUB 5285
1330 NEXT Q
1335 Q=125
1340 GOSUB 5285
1345 NEXT Q1
1350 NEXT Z
1355 FOR Q=126 TO 133
1360 Z=FNA(8)
1365 GOSUB 5285
1370 NEXT Q
1375 Q=101
1380 FOR A=1 TO 3
1385 Z=FNA(8)
1390 GOSUB 5285
1395 C(A,1)=X
1400 C(A,2)=Y
1405 C(A,3)=Z
1410 C(A,4)=0
1415 NEXT A
1420 RC=0
1425 ST=2
1430 DX=14
1435 R$(3)="MAN"
1440 Q=112+FNA(12)
1445 Z=FNA(8)
1450 GOSUB 5285
1455 R(1)=X
1460 R(2)=Y
1465 R(3)=Z
1470 Q=109
1475 Z=FNA(8)
1480 GOSUB 5285
1485 O(1)=X
1490 O(2)=Y
1495 O(3)=Z
1500 BF=0 : OT=8 : AV=0 : HT=0 : T=1 : VF=0 : LF=0
1505 TC=0 : GP=60 : RF=0 : OF=0 : BL=0 : IQ=8 : SX=0
1510 FOR Q=1 TO 8
1515 T(Q)=0
1520 NEXT Q
1525 PRINT CHR$(7);
1530 PRINT "ALL RIGHT, BOLD ONE."
1535 PRINT "YOU MAY BE AN ELF, DWARF, MAN, OR HOBBIT."
1540 GOSUB 5405
1545 FOR Q=1 TO 4
1550 IF LEFT$(R$(Q),1)=O$ THEN RC=Q : ST=ST+2*Q : DX=DX-2*Q
1555 NEXT Q
1560 PRINT
1565 OT=OT+4*(RC=1)
1570 IF RC > 0 THEN R$(3)="HUMAN" : GOTO 1585
1575 PRINT "** THAT WAS INCORRECT. PLEASE TYPE E, D, M, OR H."
1580 GOTO 1535
1585 PRINT "WHICH SEX TO YOU PREFER";
1590 GOSUB 5415
1595 IF O$="M" THEN SX=1 : GOTO 1615
1600 IF O$="F" GOTO 1615
1605 PRINT "** CUTE ";R$(RC);", REAL CUTE. TRY M OR F."
1610 GOTO 1585
1615 PRINT
1620 PRINT "OK, ";R$(RC);", YOU HAVE THE FOLLOWING ATTRIBUTES :"
1625 PRINT "STRENGTH =";ST;" INTELLIGENCE =";IQ;" DEXTERITY =";DX
1630 PRINT "AND";OT;"OTHER POINTS TO ALLOCATE AS YOU WISH."
1635 PRINT
1640 Z$="STRENGTH"
1645 GOSUB 5430
1650 ST=ST+Q
1655 IF OT=0 GOTO 1695
1660 Z$="INTELLIGENCE"
1665 GOSUB 5430
1670 IQ=IQ+Q
1675 IF OT=0 GOTO 1695
1680 Z$="DEXTERITY"
1685 GOSUB 5430
1690 DX=DX+Q
1695 PRINT "OK, ";R$(RC);", YOU HAVE 60 GOLD PIECES (GP'S)."
1700 Z$="ARMOR"
1705 GOSUB 5555
1710 AV=0 : WV=0 : FL=0 : WC=0
1715 PRINT "PLATE<30> CHAINMAIL<20> LEATHER<10> NOTHING<0>"
1720 GOSUB 5405
1725 IF O$="N" GOTO 1755
1730 AV=-3*(O$="P")-2*(O$="C")-(O$="L")
1735 IF AV > 0 GOTO 1755
1740 PRINT
1745 PRINT "** ARE YOU A ";R$(RC);" OR ";C$(FNA(12)+12);"?"
1750 GOTO 1700
1755 AH=AV*7 : GP=GP-AV*10
1760 PRINT
1765 PRINT "OK, BOLD ";R$(RC);", YOU HAVE";GP;"GP'S LEFT."
1770 Z$="WEAPONS"
1775 GOSUB 5555
1780 PRINT "SWORD<30> MACE<20> DAGGER<10> NOTHING<0>"
1785 GOSUB 5405
1790 IF O$="N" GOTO 1820
1795 WV=-3*(O$="S")-2*(O$="M")-(O$="D")
1800 IF WV > 0 GOTO 1820
1805 PRINT
1810 PRINT "** IS YOUR IQ REALLY";IQ;"?"
1815 GOTO 1770
1820 GP=GP-WV*10
1825 IF GP < 20 GOTO 1855
1830 PRINT
1835 PRINT "DO YOU WANT TO BUY A LAMP FOR 20 GP'S";
1840 GOSUB 5415
1845 IF O$="Y" THEN LF=1 : GP=GP-20 : GOTO 1855
1850 IF O$ <> "N" THEN PRINT : PRINT Y$ : PRINT : GOTO 1835
1855 PRINT
1860 IF GP < 1 THEN Q=0 : GOTO 1915
1865 PRINT "OK, ";R$(RC);", YOU HAVE";GP;"GOLD PIECES LEFT."
1870 PRINT
1875 INPUT "FLARES COST 1 GP EACH. HOW MANY DO YOU WANT";O$
1880 Q=VAL(O$)
1885 PRINT
1890 IF Q > 0 OR ASC(O$)=48 GOTO 1910
1895 PRINT "** IF YOU DON'T WANT ANY, JUST TYPE 0 (ZERO)."
1900 PRINT
1905 GOTO 1875
1910 IF Q > GP THEN PRINT "** YOU CAN ONLY AFFORD";GP;"." : PRINT : GOTO 1875
1915 FL=FL+Q : GP=GP-Q
1920 X=1 : Y=4 : Z=1
1925 PRINT "OK, ";R$(RC);", YOU ARE NOW ENTERING THE CASTLE!"
1930 GOTO 3450
1935 REM
1940 REM MAIN PROCESSING LOOP
1945 REM
1950 T=T+1
1955 IF RF+OF > 0 GOTO 2020
1960 IF C(1,4) > T(1) THEN T=T+1
1965 IF C(2,4) > T(3) THEN GP=GP-FNA(5)
1970 IF GP < 0 THEN GP=0
1975 IF C(3,4) <= T(5) GOTO 2020
1980 A=X : B=Y : C=Z
1985 X=FNA(8) : Y=FNA(8) : Z=FNA(8)
1990 L(FND(Z))=FNE(L(FND(Z)))+100
1995 X=A : Y=B : Z=C
2000 IF L(FND(Z)) <> 1 GOTO 2020
2005 FOR Q=1 TO 3
2010 C(Q,4)=-(C(Q,1)=X)*(C(Q,2)=Y)*(C(Q,3)=Z)
2015 NEXT Q
2020 IF FNA(5) > 1 GOTO 2165
2025 PRINT
2030 PRINT "YOU ";
2035 Q=FNA(7)+BL
2040 IF Q > 7 THEN Q=4
2045 ON Q GOSUB 2125,2065,2115,2055,2135,2145,2155
2050 GOTO 2165
2055 PRINT "STEPPED ON A FROG!"
2060 RETURN
2065 PRINT "HEAR ";
2070 ON FNA(4) GOTO 2075,2085,2095,2105
2075 PRINT "A SCREAM!"
2080 RETURN
2085 PRINT "FOOTSTEPS!"
2090 RETURN
2095 PRINT "A WUMPUS!"
2100 RETURN
2105 PRINT "THUNDER!"
2110 RETURN
2115 PRINT "SNEEZED!"
2120 RETURN
2125 PRINT "SEE A BAT FLY BY!"
2130 RETURN
2135 PRINT "SMELL ";C$(12+FNA(13));" FRYING!"
2140 RETURN
2145 PRINT "FEEL LIKE YOU'RE BEING WATCHED!"
2150 RETURN
2155 PRINT "HEAR FAINT RUSTLING NOISES!"
2160 RETURN
2165 IF BL+T(4) <> 2 GOTO 2185
2170 PRINT
2175 PRINT C$(29);" CURES YOUR BLINDNESS!"
2180 BL=0
2185 IF BF+T(6) <> 2 GOTO 2205
2190 PRINT
2195 PRINT C$(31);" DISSOLVES THE BOOK!"
2200 BF=0
2205 PRINT
2210 LINE INPUT "ENTER YOUR COMMAND : ";O$
2215 IF LEFT$(O$,2)="DR" GOTO 2870
2220 O$=LEFT$(O$,1)
2225 IF O$="N" GOTO 2435
2230 IF (O$="S") OR (O$="W") OR (O$="E") GOTO 2440
2235 IF O$="U" GOTO 2465
2240 IF O$="D" GOTO 2480
2245 IF O$="M" GOTO 2505
2250 IF O$="F" THEN ON BL+1 GOTO 2620,2505
2255 IF O$="L" THEN ON BL+1 GOTO 2750,2505
2260 IF O$="O" GOTO 2965
2265 IF O$="G" THEN ON BL+1 GOTO 3185,2505
2270 IF O$="T" THEN PRINT : ON RF+1 GOTO 3315,3335
2275 IF O$="Q" GOTO 3390
2280 IF O$<>"H" GOTO 2420
2285 PRINT CHR$(27);"E"
2290 PRINT "*** WIZARD'S CASTLE COMMAND AND INFORMATION SUMMARY ***"
2295 PRINT
2300 PRINT "THE FOLLOWING COMMANDS ARE AVAILABLE :"
2305 PRINT
2310 PRINT "H/ELP N/ORTH S/OUTH E/AST W/EST U/P"
2315 PRINT "D/OWN DR/INK M/AP F/LARE L/AMP O/PEN"
2320 PRINT "G/AZE T/ELEPORT Q/UIT"
2325 PRINT
2330 PRINT "THE CONTENTS OF ROOMS ARE AS FOLLOWS :"
2335 PRINT
2340 PRINT ". = EMPTY ROOM B = BOOK C = CHEST"
2345 PRINT "D = STAIRS DOWN E = ENTRANCE/EXIT F = FLARES"
2350 PRINT "G = GOLD PIECES M = MONSTER O = CRYSTAL ORB"
2355 PRINT "P = MAGIC POOL S = SINKHOLE T = TREASURE"
2360 PRINT "U = STAIRS UP V = VENDOR W = WARP/ORB"
2365 PRINT
2370 PRINT "THE BENEFITS OF HAVING TREASURES ARE :"
2375 PRINT
2380 PRINT "RUBY RED - AVOID LETHARGY PALE PEARL - AVOID LEECH"
2385 PRINT "GREEN GEM - AVOID FORGETTING OPAL EYE - CURES BLINDNESS"
2390 PRINT "BLUE FLAME - DISSOLVES BOOKS NORN STONE - NO BENEFIT"
2395 PRINT "PALANTIR - NO BENEFIT SILMARIL - NO BENEFIT"
2400 PRINT
2405 PRINT "PRESS RETURN WHEN READY TO RESUME, ";R$(RC);".";
2410 LINE INPUT "";O$
2415 GOTO 1950
2420 PRINT
2425 PRINT "** SILLY ";R$(RC);", THAT WASN'T A VALID COMMAND!"
2430 GOTO 1950
2435 IF L(FND(Z))=2 GOTO 4970
2440 X=X+(O$="N")-(O$="S")
2445 Y=Y+(O$="W")-(O$="E")
2450 X=FNB(X)
2455 Y=FNB(Y)
2460 GOTO 3450
2465 IF L(FND(Z))=3 THEN Z=Z-1 : GOTO 3450
2470 Z$="UP"
2475 GOTO 2490
2480 Z$="DOWN"
2485 IF L(FND(Z))=4 THEN Z=Z+1 : GOTO 3450
2490 PRINT
2495 PRINT "** THERE ARE NO STAIRS GOING ";Z$;" FROM HERE!"
2500 GOTO 1950
2505 IF BL <> 1 GOTO 2540
2510 PRINT
2515 PRINT "** YOU CAN'T SEE ANYTHING, YOU DUMB ";R$(RC);"!"
2520 GOTO 1950
2525 REM
2530 REM DISPLAY MAP OF CURRENT CASTLE LEVEL
2535 REM
2540 PRINT
2545 A=X : B=Y
2550 FOR X=1 TO 8
2555 FOR Y=1 TO 8
2560 Q=L(FND(Z))
2565 IF Q > 99 THEN Q=Q-100 ' LET Q=34 TO HIDE ROOMS
2570 IF X=A AND Y=B THEN PRINT "<";I$(Q);"> "; : GOTO 2580
2575 PRINT " ";I$(Q);" ";
2580 NEXT Y
2585 PRINT
2590 PRINT
2595 NEXT X
2600 X=A : Y=B
2605 GOTO 2725
2610 PRINT ") LEVEL";Z
2615 GOTO 1950
2620 IF FL <> 0 GOTO 2650
2625 PRINT "** HEY, BRIGHT ONE, YOU'RE OUT OF FLARES!"
2630 GOTO 1950
2635 REM
2640 REM DISPLAY ADJACENT ROOM CONTENTS WITH FLARE
2645 REM
2650 PRINT
2655 FL=FL-1
2660 A=X : B=Y
2665 FOR Q1=A-1 TO A+1
2670 X=FNB(Q1)
2675 FOR Q2=B-1 TO B+1
2680 Y=FNB(Q2)
2685 Q=FNE(L(FND(Z)))
2690 L(FND(Z))=Q
2695 PRINT " ";I$(Q);" ";
2700 NEXT Q2
2705 PRINT
2710 PRINT
2715 NEXT Q1
2720 X=A : Y=B
2725 GOSUB 5570
2730 GOTO 1950
2735 REM
2740 REM DISPLAY CONTENTS OF ADJACENT ROOM WITH LAMP
2745 REM
2750 IF LF <> 0 GOTO 2770
2755 PRINT
2760 PRINT "** YOU DON'T HAVE A LAMP, ";R$(RC);"!"
2765 GOTO 1950
2770 PRINT
2775 PRINT "WHERE DO YOU WANT TO SHINE THE LAMP (N,S,E,W)";
2780 GOSUB 5415
2785 A=X : B=Y
2790 X=FNB(X+(O$="N")-(O$="S"))
2795 Y=FNB(Y+(O$="W")-(O$="E"))
2800 IF A-X+B-Y <> 0 GOTO 2820
2805 PRINT
2810 PRINT "** THAT'S NOT A DIRECTION, ";R$(RC);"!"
2815 GOTO 1950
2820 PRINT
2825 PRINT "THE LAMP SHINES INTO (";X;",";Y;") LEVEL";Z;"."
2830 PRINT
2835 L(FND(Z))=FNE(L(FND(Z)))
2840 PRINT "THERE YOU WILL FIND ";C$(L(FND(Z)));"."
2845 X=A : Y=B
2850 GOTO 1950
2855 REM
2860 REM TAKE A DRINK FROM A POOL
2865 REM
2870 IF L(FND(Z))=5 GOTO 2890
2875 PRINT
2880 PRINT "** IF YOU WANT A DRINK, FIND A POOL!"
2885 GOTO 1950
2890 Q=FNA(8)
2895 PRINT
2900 PRINT "YOU TAKE A DRINK AND ";
2905 IF Q < 7 THEN PRINT "FEEL ";
2910 ON Q GOTO 2915,2920,2925,2930,2935,2940,2945,2955
2915 ST=FNC(ST+FNA(3)) : PRINT "STRONGER." : GOTO 1950
2920 ST=ST-FNA(3) : PRINT "WEAKER." : ON (1-(ST<1)) GOTO 1950,4910
2925 IQ=FNC(IQ+FNA(3)) : PRINT "SMARTER." : GOTO 1950
2930 IQ=IQ-FNA(3) : PRINT "DUMBER." : ON (1-(IQ<1)) GOTO 1950,4910
2935 DX=FNC(DX+FNA(3)) : PRINT "NIMBLER." : GOTO 1950
2940 DX=DX-FNA(3) : PRINT "CLUMSIER." : ON (1-(DX<1)) GOTO 1950,4910
2945 Q=FNA(4) : IF Q=RC GOTO 2945
2950 RC=Q : PRINT "BECOME A ";R$(RC);"." : GOTO 1950
2955 SX=1-SX : PRINT "TURN INTO A "; : IF SX=0 THEN PRINT "FE";
2960 PRINT "MALE ";R$(RC);"!" : GOTO 1950
2965 IF L(FND(Z)) <> 6 GOTO 2985
2970 PRINT
2975 PRINT "YOU OPEN THE CHEST AND"
2980 GOTO 3115
2985 IF L(FND(Z)) <> 12 GOTO 3005
2990 PRINT
2995 PRINT "YOU OPEN THE BOOK AND"
3000 GOTO 3020
3005 PRINT
3010 PRINT "** THE ONLY THING OPENED WAS YOUR BIG MOUTH!"
3015 GOTO 1950
3020 ON FNA(6) GOTO 3025,3040,3050,3060,3075,3090
3025 PRINT "FLASH! OH NO! YOU ARE NOW A BLIND ";R$(RC);"!"
3030 BL=1
3035 GOTO 3105
3040 PRINT "IT'S ANOTHER VOLUME OF ZOT'S POETRY! - YECH!!"
3045 GOTO 3105
3050 PRINT "IT'S AN OLD COPY OF PLAY";R$(FNA(4));"!"
3055 GOTO 3105
3060 PRINT "IT'S A MANUAL OF DEXTERITY!"
3065 DX=18
3070 GOTO 3105
3075 PRINT "IT'S A MANUAL OF STRENGTH!"
3080 ST=18
3085 GOTO 3105
3090 PRINT "THE BOOK STICKS TO YOUR HANDS -"
3095 PRINT "NOW YOU ARE UNABLE TO DRAW YOUR WEAPON!"
3100 BF=1
3105 L(FND(Z))=1
3110 GOTO 1950
3115 ON FNA(4) GOTO 3120,3140,3160,3140
3120 PRINT "KABOOM! IT EXPLODES!!"
3125 Q=FNA(6)
3130 GOSUB 4860
3135 ON (1-(ST<1)) GOTO 3105,4910
3140 Q=FNA(1000)
3145 PRINT "FIND";Q;"GOLD PIECES!"
3150 GP=GP+Q
3155 GOTO 3105
3160 PRINT "GAS!! YOU STAGGER FROM THE ROOM!"
3165 L(FND(Z))=1
3170 T=T+20
3175 O$=MID$("NSEW",FNA(4),1)
3180 GOTO 2440
3185 IF L(FND(Z))=11 GOTO 3205
3190 PRINT
3195 PRINT "** IT'S HARD TO GAZE WITHOUT AN ORB!"
3200 GOTO 1950
3205 PRINT
3210 PRINT "YOU SEE ";
3215 ON FNA(6) GOTO 3220,3230,3240,3250,3285,3305
3220 PRINT "YOURSELF IN A BLOODY HEAP!"
3225 ST=ST-FNA(2) : ON (1-(ST<1)) GOTO 1950,4910
3230 PRINT "YOURSELF DRINKING FROM A POOL AND BECOMING ";C$(12+FNA(13));"!"
3235 GOTO 1950
3240 PRINT C$(12+FNA(13));" GAZING BACK AT YOU!"
3245 GOTO 1950
3250 A=X : B=Y : C=Z
3255 X=FNA(8) : Y=FNA(8) : Z=FNA(8)
3260 Q=FNE(L(FND(Z)))
3265 L(FND(Z))=Q
3270 PRINT C$(Q);" AT (";X;",";Y;") LEVEL";Z;"."
3275 X=A : Y=B : Z=C
3280 GOTO 1950
3285 A=FNA(8) : B=FNA(8) : C=FNA(8)
3290 IF FNA(8) < 4 THEN A=O(1) : B=O(2) : C=O(3)
3295 PRINT "***THE ORB OF ZOT*** AT (";A;",";B;") LEVEL";C;"!"
3300 GOTO 1950
3305 PRINT "A SOAP OPERA RERUN!"
3310 GOTO 1950
3315 IF RF <> 0 GOTO 3335
3320 PRINT
3325 PRINT "** YOU CAN'T TELEPORT WITHOUT THE RUNESTAFF!"
3330 GOTO 1950
3335 Z$="X-COORDINATE"
3340 GOSUB 5485
3345 X=Q
3350 Z$="Y-COORDINATE"
3355 GOSUB 5485
3360 Y=Q
3365 Z$="Z-COORDINATE"
3370 GOSUB 5485
3375 Z=Q
3380 O$="T"
3385 GOTO 3450
3390 PRINT
3395 PRINT "DO YOU REALLY WANT TO QUIT NOW";
3400 GOSUB 5415
3405 PRINT
3410 IF O$="Y" GOTO 3425
3415 PRINT "** THEN DON'T SAY THAT YOU DO!"
3420 GOTO 1950
3425 PRINT
3430 GOTO 5030
3435 REM
3440 REM DISPLAY STATUS INFORMATION
3445 REM
3450 PRINT
3455 IF BL=0 THEN GOSUB 5570 : PRINT
3460 PRINT "STRENGTH =";ST;" INTELLIGENCE =";IQ;" DEXTERITY =";DX
3465 PRINT "TREASURES =";TC;" FLARES =";FL;" GOLD PIECES =";GP
3470 PRINT "WEAPON = ";W$(WV+1);" ARMOR = ";W$(AV+5);
3475 IF LF=1 THEN PRINT " AND A LAMP";
3480 PRINT
3485 WC=0
3490 Q=FNE(L(FND(Z)))
3495 L(FND(Z))=Q
3500 Z$="YOU NOW HAVE"
3505 PRINT
3510 PRINT "HERE YOU FIND ";C$(Q);"."
3515 IF (Q<7) OR (Q=11) OR (Q=12) GOTO 1950
3520 IF Q=7 THEN GP=GP+FNA(10) : PRINT Z$;GP;"." : GOTO 3105
3525 IF Q=8 THEN FL=FL+FNA(5) : PRINT Z$;FL;"." : GOTO 3105
3530 IF Q > 9 GOTO 3545
3535 IF (O(1)=X) AND (O(2)=Y) AND (O(3)=Z) THEN ON (1-(O$="T")) GOTO 2440,5175
3540 X=FNA(8) : Y=FNA(8) : Z=FNA(8) : GOTO 3450
3545 IF Q=10 THEN Z=FNB(Z+1) : GOTO 3450
3550 IF Q <= 25 OR Q >= 34 GOTO 3580
3555 PRINT
3560 PRINT "IT'S NOW YOURS!"
3565 T(Q-25)=1
3570 TC=TC+1
3575 GOTO 3105
3580 A=L(FND(Z))-12
3585 WC=0
3590 IF (A<13) OR (VF=1) GOTO 4185
3595 PRINT
3600 PRINT "YOU MAY TRADE WITH, ATTACK, OR IGNORE THE VENDOR."
3605 GOSUB 5405
3610 IF O$="I" GOTO 1950
3615 IF O$ <> "A" GOTO 3640
3620 VF=1
3625 PRINT
3630 PRINT "YOU'LL BE SORRY THAT YOU DID THAT!"
3635 GOTO 4185
3640 IF O$="T" GOTO 3660
3645 PRINT
3650 PRINT "** NICE SHOT, ";R$(RC);"!"
3655 GOTO 3595
3660 FOR Q=1 TO 8
3665 A=FNA(Q*1500)
3670 IF T(Q)=0 GOTO 3700
3675 PRINT
3680 PRINT "DO YOU WANT TO SELL ";C$(Q+25);" FOR";A;"GP'S";
3685 GOSUB 5415
3690 IF O$="Y" THEN TC=TC-1 : T(Q)=0 : GP=GP+A : GOTO 3700
3695 IF O$ <> "N" THEN PRINT Y$ : GOTO 3675
3700 NEXT Q
3705 IF GP >= 1000 GOTO 3725
3710 PRINT
3715 PRINT "YOU'RE TOO POOR TO TRADE, ";R$(RC);"."
3720 GOTO 1950
3725 IF GP < 1250 GOTO 3975
3730 PRINT
3735 PRINT "OK, ";R$(RC);", YOU HAVE";GP;"GP'S AND ";W$(AV+5);" ARMOR."
3740 PRINT
3745 Z$="ARMOR"
3750 GOSUB 5555
3755 PRINT "NOTHING<0> LEATHER<1250> ";
3760 IF GP > 1499 THEN PRINT "CHAINMAIL<1500> ";
3765 IF GP > 1999 THEN PRINT "PLATE<2000>";
3770 PRINT
3775 GOSUB 5405
3780 PRINT
3785 IF O$="N" GOTO 3850
3790 IF O$="L" THEN GP=GP-1250 : AV=1 : AH=7 : GOTO 3850
3795 IF O$ <> "C" OR GP >= 1500 GOTO 3810
3800 PRINT "** YOU HAVEN'T GOT THAT MUCH CASH ON HAND!"
3805 GOTO 3740
3810 IF O$="C" THEN GP=GP-1500 : AV=2 : AH=14 : GOTO 3850
3815 IF O$ <> "P" OR GP >= 2000 GOTO 3830
3820 PRINT "** YOU CAN'T AFFORD PLATE ARMOR!"
3825 GOTO 3740
3830 IF O$="P" THEN GP=GP-2000 : AV=3 : AH=21 : GOTO 3850
3835 PRINT
3840 PRINT "** DON'T BE SILLY. CHOOSE A SELECTION."
3845 GOTO 3770
3850 IF GP < 1250 GOTO 3975
3855 PRINT
3860 PRINT "YOU HAVE";GP;"GP'S LEFT WITH ";W$(WV+1);" IN HAND."
3865 PRINT
3870 Z$="WEAPON"
3875 GOSUB 5555
3880 PRINT "NOTHING<0> DAGGER<1250> ";
3885 IF GP > 1499 THEN PRINT "MACE<1500> ";
3890 IF GP > 1999 THEN PRINT "SWORD<2000>";
3895 PRINT
3900 GOSUB 5405
3905 PRINT
3910 IF O$="N" GOTO 3975
3915 IF O$="D" THEN GP=GP-1250 : WV=1 : GOTO 3975
3920 IF O$ <> "M" OR GP >= 1500 GOTO 3935
3925 PRINT "** SORRY SIR, I'M AFRAID I DON'T GIVE CREDIT!"
3930 GOTO 3865
3935 IF O$="M" THEN GP=GP-1500 : WV=2 : GOTO 3975
3940 IF O$ <> "S" OR GP >= 2000 GOTO 3960
3945 PRINT "** YOUR DUNGEON EXPRESS CARD - ";
3950 PRINT "YOU LEFT HOME WITHOUT IT!"
3955 GOTO 3865
3960 IF O$="S" THEN GP=GP-2000 : WV=3 : GOTO 3975
3965 PRINT "** TRY CHOOSING A SELECTION!"
3970 GOTO 3895
3975 IF GP < 1000 GOTO 1950
3980 Z$="STRENGTH"
3985 GOSUB 5525
3990 IF O$ <> "Y" GOTO 4020
3995 GP=GP-1000
4000 ST=FNC(ST+FNA(6))
4005 Q=ST
4010 GOSUB 5540
4015 GOTO 3975
4020 IF O$ <> "N" THEN PRINT Y$ : GOTO 3980
4025 IF GP < 1000 GOTO 1950
4030 Z$="INTELLIGENCE"
4035 GOSUB 5525
4040 IF O$ <> "Y" GOTO 4070
4045 GP=GP-1000
4050 IQ=FNC(IQ+FNA(6))
4055 Q=IQ
4060 GOSUB 5540
4065 GOTO 4025
4070 IF O$ <> "N" THEN PRINT Y$ : GOTO 4030
4075 IF GP < 1000 GOTO 1950
4080 Z$="DEXTERITY"
4085 GOSUB 5525
4090 IF O$ <> "Y" GOTO 4120
4095 GP=GP-1000
4100 DX=FNC(DX+FNA(6))
4105 Q=DX
4110 GOSUB 5540
4115 GOTO 4075
4120 IF O$ <> "N" THEN PRINT Y$ : GOTO 4080
4125 IF (GP<1000) OR (LF=1) GOTO 1950
4130 PRINT
4135 PRINT "DO YOU WANT TO BUY A LAMP FOR 1000 GP'S";
4140 GOSUB 5415
4145 IF O$ <> "Y" GOTO 4175
4150 GP=GP-1000
4155 LF=1
4160 PRINT
4165 PRINT "IT'S GUARANTEED TO OUTLIVE YOU!"
4170 GOTO 1950
4175 IF O$ <> "N" THEN PRINT Y$ : GOTO 4130
4180 GOTO 1950
4185 Q1=1+INT(A/2) : Q2=A+2 : Q3=1
4190 IF (C(1,4)>T(1)) OR (BL=1) OR (DX<FNA(9)+FNA(9)) GOTO 4700
4195 PRINT
4200 PRINT "YOU'RE FACING ";C$(A+12);"!"
4205 PRINT
4210 PRINT "YOU MAY ATTACK OR RETREAT."
4215 IF Q3=1 THEN PRINT "YOU CAN ALSO ATTEMPT A BRIBE."
4220 IF IQ > 14 THEN PRINT "YOU CAN ALSO CAST A SPELL."
4225 PRINT
4230 PRINT "YOUR STRENGTH IS";ST;"AND YOUR DEXTERITY IS";DX;"."
4235 GOSUB 5405
4240 IF O$ <> "A" GOTO 4445
4245 IF WV <> 0 GOTO 4265
4250 PRINT
4255 PRINT "** POUNDING ON ";C$(A+12);" WON'T HURT IT!"
4260 GOTO 4700
4265 IF BF <> 1 GOTO 4285
4270 PRINT
4275 PRINT "** YOU CAN'T BEAT IT TO DEATH WITH A BOOK!"
4280 GOTO 4700
4285 IF DX >= FNA(20)+(3*BL) GOTO 4305
4290 PRINT
4295 PRINT "YOU MISSED, TOO BAD!"
4300 GOTO 4700
4305 Z$=RIGHT$(C$(A+12),LEN(C$(A+12))-2)
4310 IF LEFT$(Z$,1)=" " THEN Z$=MID$(Z$,2)
4315 PRINT
4320 PRINT "YOU HIT THE EVIL ";Z$;"!"
4325 Q2=Q2-WV
4330 IF (A <> 9 AND A <> 12) GOTO 4355
4335 IF FNA(8) <> 1 GOTO 4355
4340 PRINT
4345 PRINT "OH NO! YOUR ";W$(WV+1);" BROKE!"
4350 WV=0
4355 IF Q2 > 0 GOTO 4700
4360 PRINT
4365 MC=MC-1
4370 PRINT C$(A+12);" LIES DEAD AT YOUR FEET!"
4375 IF H > T-60 GOTO 4395
4380 PRINT
4385 PRINT "YOU SPEND AN HOUR EATING ";C$(A+12);E$(FNA(8));"."
4390 H=T
4395 IF X <> R(1) OR Y <> R(2) OR Z <> R(3) THEN ON (1-(A=13)) GOTO 4420,5305
4400 PRINT
4405 PRINT "GREAT ZOT! YOU'VE FOUND THE RUNESTAFF!";CHR$(7)
4410 R(1)=0
4415 RF=1
4420 Q=FNA(1000)
4425 PRINT
4430 PRINT "YOU NOW GET HIS HOARD OF";Q;"GP'S!"
4435 GP=GP+Q
4440 GOTO 3105
4445 IF O$="R" GOTO 4700
4450 IF O$ <> "C" GOTO 4595
4455 IF IQ >= 15 OR Q3 <= 1 GOTO 4475
4460 PRINT
4465 PRINT "** YOU CAN'T CAST A SPELL NOW!"
4470 GOTO 4195
4475 PRINT
4480 PRINT "WHICH SPELL (WEB, FIREBALL, DEATHSPELL)";
4485 GOSUB 5415
4490 PRINT
4495 IF O$ <> "W" GOTO 4515
4500 ST=ST-1
4505 WC=FNA(8)+1
4510 ON (1-(ST<1)) GOTO 4700,4910
4515 IF O$ <> "F" GOTO 4560
4520 Q=FNA(7)+FNA(7)
4525 ST=ST-1
4530 IQ=IQ-1
4535 IF (IQ < 1) OR (ST < 1) GOTO 4910
4540 PRINT "IT DOES";Q;"POINTS WORTH OF DAMAGE."
4545 PRINT
4550 Q2=Q2-Q
4555 GOTO 4355
4560 IF O$="D" GOTO 4580
4565 PRINT
4570 PRINT "** TRY ONE OF THE OPTIONS GIVEN."
4575 GOTO 4195
4580 PRINT "DEATH . . . ";
4585 IF IQ < FNA(4)+15 THEN PRINT "YOURS!" : IQ=0 : GOTO 4910
4590 PRINT "HIS!" : Q2=0 : GOTO 4360
4595 IF O$="B" AND Q3 <= 1 GOTO 4615
4600 PRINT
4605 PRINT "** CHOOSE ONE OF THE OPTIONS LISTED."
4610 GOTO 4195
4615 IF TC <> 0 GOTO 4635
4620 PRINT
4625 PRINT "ALL I WANT IS YOUR LIFE!"
4630 GOTO 4700
4635 Q=FNA(8)
4640 IF T(Q)=0 GOTO 4635
4645 PRINT
4650 PRINT "I WANT ";C$(Q+25);". WILL YOU GIVE IT TO ME";
4655 GOSUB 5415
4660 IF O$="N" GOTO 4700
4665 IF O$ <> "Y" THEN PRINT Y$ : GOTO 4645
4670 T(Q)=0
4675 TC=TC-1
4680 PRINT
4685 PRINT "OK, JUST DON'T TELL ANYONE ELSE."
4690 VF=VF+(L(FND(Z))=25)
4695 GOTO 1950
4700 Q3=2
4705 IF WC <= 0 GOTO 4720
4710 WC=WC-1
4715 IF WC=0 THEN PRINT : PRINT "THE WEB JUST BROKE!"
4720 Z$=RIGHT$(C$(A+12),LEN(C$(A+12))-2)
4725 IF LEFT$(Z$,1)=" " THEN Z$=MID$(Z$,2)
4730 IF WC <= 0 GOTO 4750
4735 PRINT
4740 PRINT "THE ";Z$;" IS STUCK AND CAN'T ATTACK NOW!"
4745 GOTO 4805
4750 PRINT
4755 PRINT "THE ";Z$;" ATTACKS!"
4760 IF DX < FNA(7)+FNA(7)+FNA(7)+3*BL GOTO 4780
4765 PRINT
4770 PRINT "WHAT LUCK, HE MISSED YOU!"
4775 GOTO 4805
4780 PRINT
4785 PRINT "OUCH! HE HIT YOU!"
4790 Q=Q1
4795 GOSUB 4860
4800 IF ST < 1 GOTO 4910
4805 IF O$ <> "R" GOTO 4195
4810 PRINT
4815 PRINT "YOU HAVE ESCAPED!"
4820 PRINT
4825 PRINT "DO YOU WANT TO GO NORTH, SOUTH, EAST, OR WEST";
4830 GOSUB 5415
4835 IF O$="N" OR O$="S" OR O$="E" OR O$="W" GOTO 2440
4840 PRINT
4845 PRINT "** DON'T PRESS YOUR LUCK, ";R$(RC);"!"
4850 PRINT
4855 GOTO 4825
4860 IF AV=0 GOTO 4900
4865 Q=Q-AV
4870 AH=AH-AV
4875 IF Q < 0 THEN AH=AH-Q : Q=0
4880 IF AH >= 0 GOTO 4900
4885 AH=0 : AV=0
4890 PRINT
4895 PRINT "YOUR ARMOR HAS BEEN DESTROYED . . . GOOD LUCK!"
4900 ST=ST-Q
4905 RETURN
4910 PRINT CHR$(7)
4915 GOSUB 5375
4920 PRINT "A NOBLE EFFORT, OH FORMERLY LIVING ";R$(RC);"!"
4925 PRINT
4930 PRINT "YOU DIED DUE TO LACK OF ";
4935 IF ST < 1 THEN PRINT "STRENGTH."
4940 IF IQ < 1 THEN PRINT "INTELLIGENCE."
4945 IF DX < 1 THEN PRINT "DEXTERITY."
4950 PRINT
4955 Q3=1
4960 PRINT "AT THE TIME YOU DIED, YOU HAD :"
4965 GOTO 5055
4970 Q3=0
4975 PRINT
4980 PRINT "YOU LEFT THE CASTLE WITH";
4985 IF OF=0 THEN PRINT "OUT";
4990 PRINT " THE ORB OF ZOT."
4995 PRINT
5000 IF OF=0 GOTO 5030
5005 PRINT
5010 PRINT "AN INCREDIBLY GLORIOUS VICTORY!!"
5015 PRINT
5020 PRINT "IN ADDITION, YOU GOT OUT WITH THE FOLLOWING :"
5025 GOTO 5050
5030 PRINT
5035 PRINT "A LESS THAN AWE-INSPIRING DEFEAT."
5040 PRINT
5045 PRINT "WHEN YOU LEFT THE CASTLE, YOU HAD :"
5050 IF Q3=0 THEN PRINT "YOUR MISERABLE LIFE!"
5055 FOR Q=1 TO 8
5060 IF T(Q)=1 THEN PRINT C$(Q+25)
5065 NEXT Q
5070 PRINT W$(WV+1);" AND ";W$(AV+5);
5075 IF LF=1 THEN PRINT " AND A LAMP";
5080 PRINT
5085 PRINT "YOU ALSO HAD";FL;"FLARES AND";GP;"GOLD PIECES"
5090 IF RF=1 THEN PRINT "AND THE RUNESTAFF"
5095 PRINT
5100 PRINT "AND IT TOOK YOU";T;"TURNS!"
5105 PRINT
5110 PRINT "ARE YOU FOOLISH ENOUGH TO WANT TO PLAY AGAIN";
5115 GOSUB 5415
5120 PRINT
5125 IF O$ <> "Y" GOTO 5155
5130 PRINT "SOME ";R$(RC);"S NEVER LEARN!"
5135 PRINT
5140 PRINT "PLEASE BE PATIENT WHILE THE CASTLE IS RESTOCKED."
5145 PRINT
5150 GOTO 1105
5155 IF O$ <> "N" THEN PRINT Y$ : GOTO 5110
5160 PRINT "MAYBE DUMB ";R$(RC);" IS NOT SO DUMB AFTER ALL!"
5165 PRINT
5170 GOTO 5580
5175 PRINT
5180 PRINT "GREAT UNMITIGATED ZOT!"
5185 PRINT
5190 PRINT "YOU JUST FOUND ***THE ORB OF ZOT***!"
5195 PRINT
5200 PRINT "THE RUNESTAFF HAS DISAPPEARED!"
5205 RF=0
5210 OF=1
5215 O(1)=0
5220 GOTO 3105
5225 DATA AN EMPTY ROOM,.,THE ENTRANCE,E,STAIRS GOING UP,U
5230 DATA STAIRS GOING DOWN,D,A POOL,P,A CHEST,C,GOLD PIECES,G
5235 DATA FLARES,F,A WARP,W,A SINKHOLE,S,A CRYSTAL ORB,O
5240 DATA A BOOK,B,A KOBOLD,M,AN ORC,M,A WOLF,M,A GOBLIN,M,AN OGRE,M
5245 DATA A TROLL,M,A BEAR,M,A MINOTAUR,M,A GARGOYLE,M,A CHIMERA,M
5250 DATA A BALROG,M,A DRAGON,M,A VENDOR,V,THE RUBY RED,T
5255 DATA THE NORN STONE,T,THE PALE PEARL,T,THE OPAL EYE,T
5260 DATA THE GREEN GEM,T,THE BLUE FLAME,T,THE PALANTIR,T,THE SILMARIL,T
5265 DATA X,"?",NO WEAPON," SANDWICH"
5270 DATA DAGGER," STEW",MACE," SOUP",SWORD," BURGER",NO ARMOR," ROAST"
5275 DATA LEATHER," FILET",CHAINMAIL," TACO",PLATE," PIE"
5280 DATA HOBBIT,ELF,MAN,DWARF
5285 X=FNA(8) : Y=FNA(8)
5290 IF L(FND(Z)) <> 101 GOTO 5285
5295 L(FND(Z))=Q
5300 RETURN
5305 PRINT
5310 PRINT "YOU GET ALL HIS WARES :"
5315 PRINT "PLATE ARMOR"
5320 AV=3 : AH=21
5325 PRINT "A SWORD"
5330 WV=3
5335 PRINT "A STRENGTH POTION"
5340 ST=FNC(ST+FNA(6))
5345 PRINT "AN INTELLIGENCE POTION"
5350 IQ=FNC(IQ+FNA(6))
5355 PRINT "A DEXTERITY POTION"
5360 DX=FNC(DX+FNA(6))
5365 IF LF=0 THEN PRINT "A LAMP" : LF=1
5370 GOTO 4420
5375 FOR Q=1 TO 64
5380 PRINT "*";
5385 NEXT Q
5390 PRINT
5395 PRINT
5400 RETURN
5405 PRINT
5410 PRINT "YOUR CHOICE";
5415 INPUT O$
5420 O$=LEFT$(O$,1)
5425 RETURN
5430 PRINT "HOW MANY POINTS DO YOU WISH TO ADD TO YOUR ";Z$;
5435 INPUT O$
5440 PRINT
5445 Q=VAL(O$)
5450 IF Q=0 AND ASC(O$) <> 48 THEN Q=-1
5455 IF Q<0 OR Q>OT OR Q<>INT(Q) THEN PRINT "** "; : GOTO 5430
5460 OT=OT-Q
5465 RETURN
5470 INPUT O$
5475 Q=INT(VAL(O$))
5480 RETURN
5485 PRINT
5490 PRINT Z$;
5495 INPUT O$
5500 Q=INT(VAL(O$))
5505 IF Q > 0 AND Q < 9 THEN RETURN
5510 PRINT
5515 PRINT "** TRY A NUMBER FROM 1 TO 8."
5520 GOTO 5485
5525 PRINT
5530 PRINT "DO YOU WANT TO BUY A POTION OF ";Z$;" FOR 1000 GP'S";
5535 GOTO 5415
5540 PRINT
5545 PRINT "YOUR ";Z$;" IS NOW";Q;"."
5550 RETURN
5555 PRINT
5560 PRINT "THESE ARE THE TYPES OF ";Z$;" YOU CAN BUY :"
5565 RETURN
5570 PRINT "YOU ARE AT (";X;",";Y;") LEVEL";Z;"."
5575 RETURN
5580 END
CASTLE.DOC
MLIST ver 5.0 - Multiple file lister
CTL-S pauses, CTL-X skips to next file, CTL-C aborts
--> LISTING FILE: CASTLE .DOC
*
* WIZARD'S CASTLE GAME FROM JULY/AUGUST 1980
* ISSUE OF RECREATIONAL COMPUTING MAGAZINE
*
* ORIGINAL EXIDY SORCERER VERSION BY JOSEPH R. POWER
* MODIFIED HEATH MICROSOFT BASIC VERSION BY J.F.STETSON
*
WIZARD'S CASTLE IS A FANTASY GAME ABOUT EQUAL IN COMPLEXITY TO THE SEVERAL
VERSIONS OF "ADVENTURE" WHICH ARE NOW AVAILABLE FOR MICROCOMPUTERS AND IS
A VERY LARGE "BASIC" PROGRAM IN ITS OWN RIGHT. UNLIKE ADVENTURE, THE CASTLE IS
RANDOMLY STOCKED FOR EACH GAME, WHICH MEANS THAT WINNING ONE DOES NOT DETRACT
FROM PLAYING FUTURE GAMES. AT PRESENT, THERE ARE VERISONS OF WIZARD'S CASTLE
FOR THE EXIDY SORCERER, TRS-80, HP-2000 AND HEATH H-8/H-89 COMPUTERS.
*
* BACKGROUND HISTORY
*
MANY CYCLES AGO, IN THE KINGDOM OF N'DIC, THE GNOMIC WIZARD ZOT FORGED HIS
GREAT *ORB OF POWER*. SOON AFTER DOING THIS, HE VANISHED, LEAVING BEHIND HIS
VAST SUBTERRANEAN CASTLE FILLED WITH ESURIENT MONSTERS, FABULOUS TREASURES,
AND THE INCREDIBLE *ORB OF ZOT*. FROM THAT TIME HENCE, MANY A BOLD YOUTH HAS
VENTURED INTO THE WIZARD'S CASTLE. AS YET, *NONE* HAS EVER EMERGED VICTORIOUS.
*
* INTRODUCTION
*
WIZARD'S CASTLE IS A COMPUTERIZED SIMULATION OF ONE OF THE MOST COMMON AND
POPULAR FANTASY MOTIFS - THE LONE ADVENTURER'S QUEST WITHIN AN IMMENSE UNDER-
GROUND LABYRINTH. EACH GAME IS SEPARATE FROM ALL OTHERS, SO THE GAME IS A
CHALLENGE EVEN AFTER YOU HAVE WON SEVERAL TIMES. EACH GAME WILL RESULT IN A
WIN OR A LOSS, DEPENDING ON A PLAYER'S SKILL AND LUCK. THE INSTRUCTIONS WHICH
FOLLOW EXPLAIN THE RULES AND OPTIONS OF THE GAME. IF AT ANY TIME, HOWEVER,
YOU ARE NOT SURE OF WHAT TO DO - EXPERIMENT. THE PROGRAM IS DESIGNED TO PREVENT
INVALID INPUTS.
*
* CHARACTER CREATION
*
AT THE START OF EACH GAME, YOU WILL BE ASKED A NUMBER OF QUESTIONS ABOUT WHAT
TYPE OF CHARACTER YOU WILL HAVE. YOU MUST MAKE CHOICES ABOUT THE FOLLOWING :
*
RACE YOU MAY BE AN ELF, DWARF, MAN, OR HOBBIT. EACH RACE STARTS WITH A
TOTAL OF 32 POINTS (EXCEPT HOBBITS, WHO ONLY GET 28), BUT THEY ARE
DISTRIBUTED DIFFERENTLY FOR EACH RACE.
*
SEX YOU MAY BE MALE OR FEMALE. BOTH ARE EQUAL IN ABILITY AND
IN THE NUMBER OF POINTS. BE CREATIVE WITH YOUR RESPONSE.
*
POINTS EACH CHARACTER STARTS WITH A NUMBER OF POINTS FOR THE ATTRIBUTES OF
STRENGTH (ST), INTELLIGENCE (IQ), AND DEXTERITY (DX). IN ADDITION,
THERE ARE SOME OTHER POINTS WHICH YOU MAY DISTRIBUTE BETWEEN THESE
THREE ATTRIBUTES AS YOU WISH.
*
YOUR ST, IQ, AND DX MAY BE ANY NUMBER FROM 1 TO 18. IF ANY OF THE
THREE DROPS BELOW 1, YOU HAVE DIED. FOR ALL THREE ATTRIBUTES, THE
LARGER THE NUMERICAL VALUE, THE BETTER. EACH CHARACTER ALSO STARTS
THE GAME WITH 60 GOLD PIECES (GP'S) WITH WHICH TO PURCHASE SOME,
NONE, OR ALL OF THE FOLLOWING ITEMS :
*
ARMOR YOU MAY BUY PLATE ARMOR FOR 30 GP'S, CHAINMAIL FOR 20 GP'S, OR
LEATHER FOR 10 GP'S. YOU CAN WEAR ONLY ONE SUIT OF ARMOR AT A TIME.
THE MORE EXPENSIVE THE ARMOR, THE MORE DAMAGE IT WILL ABSORB.
*
WEAPON YOU MAY BUY A SWORD FOR 30 GP'S, A MACE FOR 20 GP'S, OR A DAGGER
FOR 10 GP'S. YOU CAN ONLY CARRY A SINGLE WEAPON AT A TIME. THE MORE
EXPENSIVE THE WEAPON, THE MORE DAMAGE IT DOES TO THE VARIOUS MONSTERS.
*
LAMP IF, AFTER SELECTING ARMOR AND A WEAPON, YOU HAVE 20 GP'S OR MORE
LEFT, YOU MAY BUY A LAMP FOR 20 GP'S. HAVING THE LAMP WILL ALLOW
YOU TO LOOK INTO AN ADJACENT ROOM WITHOUT HAVING TO ENTER IT.
*
FLARES IF, AFTER ALL OTHER PURCHASES, YOU HAVE ANY MONEY LEFT, YOU MAY BUY
FLARES FOR 1 GP EACH. LIGHTING A FLARE REVEALS THE CONTENTS OF ALL
THE ROOMS SURROUNDING YOUR CURRENT LOCATION.
*
ONCE YOU HAVE CREATED AND EQUIPPED A CHARACTER, YOU ARE
READY TO ENTER THE CASTLE AND BEGIN YOUR ADVENTURES.
*
* THE CASTLE
*
THE CASTLE IS ARRANGED AS AN 8 X 8 X 8 THREE DIMENSIONAL MATRIX. THIS MEANS
THAT THERE ARE 8 LEVELS WITH 64 ROOMS ON EACH LEVEL. THE CASTLE LEVELS ARE
NUMBERED FROM 1 (THE TOP LEVEL) TO 8 (THE BOTTOM LEVEL). EACH CASTLE LEVEL
IS CONSTRUCTED LIKE A DOUGHNUT IN THAT THE NORTH EDGE IS CONNECTED TO THE
SOUTH EDGE AND THE EAST EDGE IS CONNECTED TO THE WEST EDGE. IN A SIMILAR
FASHION, THE SINKHOLES (EXPLAINED LATER) ON LEVEL 8 WILL "DROP" YOU DOWN TO
LEVEL 1. THE ONLY ROOM WHICH DOES NOT FUNCTION LIKE THIS IS THE ENTRANCE /
EXIT ROOM OF THE CASTLE WHICH IS ALWAYS LOCATED AT LOCATION (1,4) LEVEL 1.
GOING NORTH FROM THIS ROOM TAKES YOU OUT OF THE CASTLE AND ENDS THE GAME.
*
EACH ROOM OF THE CASTLE WILL HAVE AS CONTENTS ONE OF THE FOLLOWING :
*
E THE ENTRANCE / EXIT ROOM
. AN EMPTY ROOM CONTAINING NOTHING
U STAIRS GOING UP TO THE LEVEL ABOVE
D STAIRS GOING DOWN TO THE LEVEL BELOW
P A MAGIC POOL FROM WHICH YOU MAY DRINK
C A CHEST WHICH YOU MAY OPEN
B A BOOK WHICH YOU MAY OPEN
G FROM 1 TO 10 GOLD PIECES
F FROM 1 TO 3 FLARES
W A WARP TO ANOTHER RANDOM LOCATION
M A MONSTER (ONE OF 12 DIFFERENT TYPES)
V A VENDOR WHICH YOU MAY ATTACK, IGNORE OR TRADE WITH
O A CRYSTAL ORB (THIS IS NOT THE *ORB OF ZOT*)
S A SINKHOLE (A ROOM WITH NO FLOOR)
T A TREASURE (ONE OF THE 8 IN THE CASTLE)
*
THE SINGLE LETTERS ARE THE ABBREVIATIONS FOR THE ROOM CONTENTS
WHICH ARE DISPLAYED WHENEVER YOU LOOK AT YOUR MAP OR LIGHT A FLARE.
WHEN YOU LOOK AT YOUR MAP, THE ROOM YOU ARE CURRENTLY LOCATED IN
IS BRACKETED BY < >.
*
* PLAYER COMMANDS
*
WHENEVER THE PROGRAM ASKS FOR A COMMAND, YOU MUST DECIDE WHAT ACTION YOU
WISH TO PERFORM. IF YOUR CHOICE IS NOT VALID IN YOUR CURRENT SITUATION, THE
PROGRAM WILL INFORM YOU AND ALLOW YOU TO TRY AGAIN. THE FOLLOWING IS A LIST
OF THE COMMANDS WHICH THE PROGRAM UNDERSTANDS, WITH A DESCRIPTION OF THEIR
EFFECTS AND RESTRICTIONS :
*
NORTH MOVES YOU TO THE ROOM NORTH OF YOUR PRESENT POSITION. WHEN YOU
GO NORTH FROM THE ENTRANCE / EXIT ROOM, THE GAME TERMINATES.
IN ALL OTHER CASES, THE NORTH EDGE WRAPS AROUND TO THE SOUTH.
*
SOUTH MOVES YOU TO THE ROOM SOUTH OF YOUR PRESENT POSITION. IN ALL
CASES, THE SOUTH EDGE WRAPS AROUND TO THE NORTH EDGE.
*
EAST MOVES YOU TO THE ROOM EAST OF YOUR PRESENT POSITION. IN ALL
CASES, THE EAST EDGE WRAPS AROUND TO THE WEST EDGE.
*
WEST MOVES YOU TO THE ROOM WEST OF YOUR PRESENT POSITION. IN ALL
CASES, THE WEST EDGE WRAPS AROUND TO THE EAST EDGE.
*
UP CAUSES YOU TO ASCEND STAIRS GOING UP. YOU MUST BE IN A ROOM
CONTAINING STAIRS GOING UP.
*
DOWN CAUSES YOU TO DESCEND STAIRS GOING DOWN. YOU MUST BE IN A ROOM
CONTAINING STAIRS GOING DOWN.
*
DRINK CAUSES YOU TO TAKE A DRINK FROM A MAGIC POOL. YOU MAY REPEAT
THIS COMMAND AS OFTEN AS YOU WISH, BUT YOU MUST BE IN A ROOM
CONTAINING A MAGIC POOL.
*
MAP CAUSES A MAP OF THE LEVEL YOU ARE CURRENTLY ON TO BE PRINTED.
ALL UNEXPLORED ROOMS ARE DISPLAYED AS "?". ALL OTHER ROOMS ARE
DISPLAYED AS THEIR ONE CHARACTER ABBREVIATIONS. YOU MAY LOOK AT
YOUR MAP AT ANY TIME UNLESS YOU ARE EITHER BLIND OR ARE RETREATING
FROM A MONSTER.
*
FLARE CAUSES ONE OF YOUR FLARES TO BE LIT, REVEALING THE CONTENTS OF
ALL ROOMS SURROUNDING YOUR CURRENT POSITION. BECAUSE EACH EDGE
IS JOINED TO THE OPPOSITE EDGE, YOU WILL ALWAYS SEE NINE ROOMS
WITH YOUR LOCATION IN THE CENTER. EACH FLARE BURNS AWAY TO NOTHING.
YOU MAY LIGHT FLARES AS LONG AS YOU HAVE SOME AND YOU ARE NOT BLIND
OR RETREATING FROM A MONSTER. FOR THOSE WHO ARE FAMILIAR WITH ANY
OF THE COMMON "STAR TREK" GAMES, A FLARE WORKS MUCH LIKE A LONG
RANGE SENSOR SCAN WITH THE ADDITION OF WRAPAROUND.
*
LAMP ALLOWS YOU TO SHINE YOUR LAMP INTO ANY ONE OF THE ROOMS NORTH,
SOUTH, EAST, OR WEST OF YOUR CURRENT POSITION, REVEALING THE ROOM'S
CONTENTS. UNLIKE FLARES, THE LAMP MAY BE USED REPEATEDLY. YOU MAY
USE YOUR LAMP AT ANY TIME UNLESS YOU DON'T HAVE A LAMP, ARE BLIND,
OR ARE RETREATING FROM A MONSTER.
*
OPEN CAUSES YOU TO OPEN A BOOK OR A CHEST WHICH IS IN THE ROOM WITH YOU.
*
GAZE CAUSES YOU TO GAZE INTO A CRYSTAL ORB. WHEN YOU SEE YOURSELF IN A
BLOODY HEAP, YOU LOSE 1 OR 2 POINTS OF STRENGTH. WHEN YOU SEE THE
LOCATION OF THE *ORB OF ZOT*, THERE IS ONLY A 50% CHANCE THAT IT
IS CORRECT. YOU CANNOT GAZE WHEN YOU ARE BLIND OR WHEN YOU ARE NOT
IN A ROOM CONTAINING A CRYSTAL ORB.
*
TELE- ALLOWS YOU TO TELEPORT DIRECTLY INTO A SPECIFIC ROOM ANYWHERE IN
PORT THE CASTLE. THIS IS THE ONLY WAY TO ENTER THE ROOM CONTAINING THE
*ORB OF ZOT*. YOU MUST HAVE THE RUNESTAFF IN ORDER TO TELEPORT.
*
QUIT ALLOWS YOU TO END THE GAME WHILE YOU ARE STILL IN THE CASTLE. YOU
WILL BE ASKED IF YOU REALLY WANT TO QUIT, IN CASE YOU MADE A MISTAKE
OR WANT TO CHANGE YOUR MIND. IF YOU QUIT, YOU WILL LOSE THE GAME.
*
HELP CAUSES A SUMMARY OF THE AVAILABLE COMMANDS, ABBREVIATIONS USED IN
DESCRIBING THE CONTENTS OF ROOMS, AND THE BENEFITS OF POSSESSING
EACH OF THE TREASURES TO BE DISPLAYED AT ANY TIME DURING THE GAME.
*
ALL OF THE COMMANDS, EXCEPT DRINK, CAN BE ABBREVIATED TO THEIR
FIRST LETTER (M FOR MAP, Q FOR QUIT, ETC.). THE ABBREVIATION FOR
DRINK IS "DR" (TO DISTINGUISH IT FROM "D" FOR THE DOWN COMMAND).
*
* MAGIC SPELLS
*
WHENEVER YOUR INTELLIGENCE (IQ) BECOMES 15 OR HIGHER, YOU GAIN THE OPTION
TO CAST A MAGIC SPELL ON A MONSTER IF YOU HAVE THE VERY FIRST COMBAT OPTION.
THE THREE SPELLS AND THEIR EFFECTS ARE AS FOLLOWS :
*
WEB TRAPS THE MONSTER IN A STICKY WEB SO THAT IT CAN'T FIGHT BACK
AS YOU ATTACK IT. THIS SPELL LASTS FROM 2 TO 9 TURNS AND COSTS
YOU ONE STRENGTH (ST) POINT.
*
FIRE- HITS THE MONSTER WITH A BALL OF FLAME THAT CAUSES BETWEEN 2 AND 14
BALL POINTS WORTH OF DAMAGE INSTANTLY. IT COSTS ONE STRENGTH POINT AND
ONE INTELLIGENCE POINT.
*
DEATH- IS A CONTEST OF WILLS BETWEEN THE MONSTER AND YOURSELF. WHOEVER
SPELL HAS THE LOWER INTELLIGENCE DIES AT ONCE. IT COSTS NOTHING TO USE,
BUT IT IS VERY RISKY. EVEN WITH AN IQ OF 18 (THE HIGHEST POSSIBLE),
YOU STILL HAVE A 25% CHANCE OF BEING KILLED.
*
* TREASURES, CURSES, BLINDNESS, AND SUCH
*
IN THE CASTLE ARE EIGHT RANDOMLY PLACED TREASURES :
*
THE RUBY RED - WARDS OFF THE CURSE OF LETHARGY.
THE PALE PEARL - WARDS OFF THE CURSE OF THE LEECH.
THE OPAL EYE - CURES BLINDNESS.
THE GREEN GEM - WARDS OFF THE CURSE OF FORGETFULLNESS.
THE BLUE FLAME - DISSOLVES BOOKS STUCK TO YOUR HANDS.
*
THE NORN STONE - HAS NO SPECIAL POWER.
THE PALANTIR - HAS NO SPECIAL POWER.
THE SILMARIL - HAS NO SPECIAL POWER.
*
THERE ARE THREE CURSES :
*
LETHARGY - THIS GIVES THE MONSTERS THE FIRST ATTACK WHICH PREVENTS
YOU FROM BRIBING THEM OR CASTING SPELLS ON THEM.
*
LEECH - THIS TAKES FROM 1 TO 5 GP'S FROM YOU EACH TURN UNTIL YOU
HAVE NO GOLD PIECES LEFT.
*
FORGETFULLNESS - THIS CAUSES YOU TO FORGET WHAT YOU KNOW ABOUT THE
CASTLE. YOUR MAP WILL SLOWLY RETURN TO ALL QUESTION MARKS.
HOWEVER, THE CONTENTS OF THE ROOMS IN THE CASTLE ARE THE SAME.
*
IN ADDITION TO NULLIFYING THE EFFECTS OF THE CURSES, THE TREASURES ALSO
PROVIDE PROTECTION FROM TWO UNDESIRABLE THINGS WHICH CAN HAPPEN WHEN YOU
OPEN A BOOK. THESE ARE GOING BLIND, WHICH PREVENTS YOU FROM SEEING YOUR
MAPS, LIGHTING FLARES, USING YOUR LAMP, GAZING INTO ORBS, AND BEING
INFORMED OF YOUR PRESENT LOCATION, AND SECONDLY, HAVING THE BOOK STICK
TO YOUR HANDS, WHICH PREVENTS YOU FROM USING YOUR WEAPON TO FIGHT MONSTERS
(YOU CAN STILL CAST SPELLS AT THEM IF YOU ARE SMART ENOUGH, HOWEVER).
*
* VENDORS
*
ON EVERY LEVEL IN THE CASTLE, THERE ARE VENDORS WHO ARE MORE THAN WILLING
TO SELL YOU VARIOUS ITEMS AT GROSSLY INFLATED PRICES. NORMALLY, THE VENDORS
WILL MAKE YOU AN OFFER FOR EVERY TREASURE YOU HAVE, AND THEN, DEPENDING ON
THE AMOUNT OF GOLD YOU HAVE, WILL SELL YOU NEW ARMOR, A NEW WEAPON, POTIONS
OF STRENGTH, INTELLIGENCE AND DEXTERITY (NO MATTER HOW MANY POTIONS YOU BUY,
THE MAXIMUM AMOUNT OF THESE ATTRIBUTES YOU CAN HAVE IS 18), AND A LAMP, IF
YOU DON'T ALREADY HAVE ONE. IF YOU CHOOSE TO ATTACK A VENDOR, YOU WILL THEN
ANTAGONIZE EVERY VENDOR IN THE CASTLE, AND THEY WILL ALL REACT LIKE MONSTERS.
YOU WILL ALSO LOSE THE ABILITY TO TRADE WITH THEM. KILLING A VENDOR, HOWEVER,
WILL GIVE YOU NEW PLATE ARMOR, A SWORD, ONE OF EACH KIND OF POTION, AND A
LAMP (IF YOU DON'T HAVE ONE), IN ADDITION TO HIS HOARD OF BETWEEN 1 AND 1000
GOLD PIECES. TO END HOSTILITIES AND REESTABLISH TRADING PRIVILEGES, YOU MUST
BRIBE ANY VENDOR IN THE CASTLE WITH THE TREASURE OF HIS CHOICE.
*
* MONSTERS AND THE RUNESTAFF
*
THERE ARE 12 TYPES OF MONSTERS IN THE CASTLE :
*
KOBOLD, ORC, WOLF, GOBLIN, OGRE, TROLL
BEAR, MINOTAUR, GARGOYLE, CHIMERA, BALROG, DRAGON
*
PLEASE NOTE THAT EACH TIME YOU STRIKE A GARGOYLE OR A DRAGON,
THERE IS A POSSIBILITY THAT YOUR WEAPON WILL BE SHATTERED.
*
EACH MONSTER POSSESSES A HOARD OF FROM 1 TO 1000 GP'S WHICH YOU OBTAIN
WHEN YOU KILL THE MONSTER. IN ADDITION, ONE OF THE MONSTERS IS CARRYING
THE RUNESTAFF (YOU WON'T KNOW WHICH ONE UNTIL YOU KILL IT). YOU MUST HAVE
THE RUNESTAFF TO TELEPORT, AND WHEN YOU TELEPORT INTO THE CASTLE ROOM WHICH
CONTAINS THE *ORB OF ZOT*, THE RUNESTAFF DISAPPEARS (YOU MUST FIND YOUR WAY
TO THE CASTLE EXIT WITHOUT IT).
*
* WARPS AND THE *ORB OF ZOT*
*
ALL BUT ONE OF THE ROOMS DENOTED AS "W" REALLY ARE WARPS, AND WALKING,
FALLING, OR TELEPORTING INTO THEM WILL CAUSE YOU TO MOVE TO ANY ROOM IN
THE CASTLE AT RANDOM. THE ONE EXCEPTION IS THE *ORB OF ZOT*, WHICH IS
DISGUISED AS A WARP. WALKING INTO THIS ROOM ALWAYS CAUSES YOU TO MOVE ONE
ROOM FURTHER IN THE SAME DIRECTION. TO ACTUALLY ENTER THIS ROOM, YOU MUST
USE THE RUNESTAFF TO TELEPORT IN. AT THIS POINT, YOU WILL ACQUIRE THE GREAT
*ORB OF ZOT*, AND THE RUNESTAFF WILL VANISH. TO WIN THE GAME, YOU MUST LEAVE
THE CASTLE WITH THE *ORB OF ZOT*. REMEMBER THAT CRYSTAL ORBS ARE NOT THE
*ORB OF ZOT* AND CANNOT BE PICKED UP.
*
* ERROR MESSAGES
*
ANY TIME YOU RECEIVE A MESSAGE STARTING WITH "**", IT MEANS THAT THE LAST
THING YOU TYPED WAS UNACCEPTABLE TO THE PROGRAM AT THAT TIME. FOR INSTANCE,
IF YOU GET THE MESSAGE "** IT'S HARD TO GAZE WITHOUT AN ORB.", THIS MEANS
THAT YOU TRIED TO GAZE FROM A ROOM WHICH DID NOT CONTAIN A CRYSTAL ORB.
YOU ARE ALWAYS REQUIRED TO REDO YOUR LAST RESPONSE WHEN YOU RECEIVE AN
"**" TYPE MESSAGE.
*
* GOOD LUCK, AND BEWARE!
*
EOF
DONE
A0>ED TO REDO YOUR LAST RESPONSE WHEN YOU RECEIVE AN
"**" TYPE MESSAGE.
*
* GOOD LUC
CHRONSET.BAS
1 REM Program to set stack chronograph - T.R.Trilling - 6-19-82
10 GOSUB 1000 ' INTIALIZE PROGRAM
20 INPUT "DATE yymmdd ";DAT$
30 OST$="ATSD"+DAT$:GOSUB 2000 'SET DATE
40 INPUT "TIME IN 2400 MODE ";T$
50 OST$="ATST"+T$:GOSUB 2000 'SET TIME
60 INPUT "WEEKDAY ";W$
70 IF W$="MONDAY" THEN D$="0"
80 IF W$="TUESDAY" THEN D$="1"
90 IF W$="WEDNESDAY" THEN D$="2"
100 IF W$="THRUSDAY" THEN D$="3"
110 IF W$="FRIDAY" THEN D$="4"
120 IF W$="SATURDAY" THEN D$="5"
130 IF W$="SUNDAY" THEN D$="6"
140 OST$="ATSW"+D$:GOSUB 2000 'SET DAY OF THE WEEK
150 END
1000 ' Open communications to file number 1
1010 DIM OST$(10),IST$(10)
1020 DIM W$(10),TIM$(10),W(10)
1030 OPEN "COM1:300" AS #1
1045 RETURN
2000 FOR I=1 TO LEN(OST$)
2010 PRINT#1,OST$ 'OUTPUT CLOCK COMMAND
2020 NEXT I
2030 PRINT#1,CHR$(13)
2040 RETURN
COMCHRON.BAS
1 REM ********************************************************************
2 REM * Program to read time from Hayes Stack Chronograph *
3 REM * T.R.Trilling - Doylestown,Pa.18901 - 23 June 1982 *
4 REM ********************************************************************
10 GOSUB 1000 'INITILIZE PROGRAM
20 OST$="ATVT:": GOSUB 2000 'SET TIME SEPARATOR
30 OST$="ATVD-":GOSUB 2000 'SET DATE SEPARATOR
40 OST$="ATRT":GOSUB 2000:TIM$=IST$ 'READ TIME
45 TIME$=IST$
50 OST$="ATRD":GOSUB 2000:DTE$=IST$ 'READ DATE
60 OST$="ATRW":GOSUB 2000:W=VAL(IST$) 'READ WEEKDAY
70 GOSUB 3000 'CONVERT CODE TO CHARACTERS
90 MM$=MID$(DTE$,4,2) '********************************************
100 DD$=RIGHT$(DTE$,2) '* Convert date formate to date$ format *
110 YY$=LEFT$(DTE$,2) '* of IBM PC. *
120 DATE$=MM$+"-"+DD$+"-"+YY$ '********************************************
130 GOSUB 4000 'OUTPUT TIME,WEEKDAY, AND DATE ON SCREEN
135 KEY ON
140 END
1000 ' Open communications to file number 1
1030 OPEN "COM1:1200,E,7,1" AS #1
1040 RETURN
2000 FOR I=1 TO LEN(OST$) 'Length of comm. word
2010 PRINT#1,OST$; 'OUTPUT CLOCK COMMAND
2020 NEXT I
2025 PRINT#1,CHR$(13) 'Carriage return
2030 IST$="" 'CLEAR INPUT STRING
2035 INPUT#1,IST$ 'GET INPUT FROM CLOCK
2040 RETURN
2110 INPUT#1,IST$; 'GET INPUT FROM CLOCK
3000 FOR L=0 TO W 'WEEDKDAY CONVERSION SUBROUTINE
3010 READ DAY$
3020 NEXT L
3030 RETURN
3040 DATA MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY,SUNDAY
4000 CLS:LOCATE 8,25:PRINT "TIME IS ";TIM$+" - LOCAL TIME" 'DISPLAY DATA SUBROUTINE
4010 LOCATE 9,25:PRINT "TODAY IS "DATE$+" - "+DAY$
4020 RETURN
COMPRESS.BAS
10 '*****************************************************************
20 '*********** ***********
30 '*********** COMPRESS [Any BASIC Program] ***********
40 '*********** ***********
50 '*****************************************************************
60 ' * COPYRIGHT 1982 - CRAIG W. UTHE *
70 ' * WRITTEN 3/13/82 BY CRAIG W. UTHE *
80 ' * * * * * *
90 ' * ANY INDIVIDUAL MAY COPY THIS PROGRAM *
100 ' * AND MAKE MODIFICATIONS TO IT IF THAT *
110 ' * INDIVIDUAL ARRANGES TO CONTRIBUTE ONE *
120 ' * OTHER PROGRAM TO THE IPCO SOFTWARE *
130 ' * EXCHANGE LIBRARY. HOWEVER, COPIES *
140 ' * ARE NOT ALLOWED TO BE SOLD, NOT IN *
150 ' * WHOLE NOR IN PART, NOT SEPARATELY *
160 ' * NOR JOINTLY WITH OTHER SOFTWARE. *
170 ' *********************************************
180 '
190 '
200 'This is a preprocessor for BASIC which deletes all
210 ' '-comments and extra spaces (except when in quotes).
220 'All '-comment-only lines are deleted. Line numbers will
230 'be displayed as lines are compressed, except for deleted lines.
240 '
250 '**An early test-run on a very-structured program reduced the
260 '**program from 20,600 B to 9,600 B. (ASCII format storage
270 '**was about 1 K greater for each.) Apparently, COMPRESS
280 '**cut the size of the program to LESS than HALF!!!!
290 '**BUT, it takes a LONG time: 2 to 3 seconds/line
300 '
310 '
320 'BE SURE that the BASIC uncompressed file is stored as an
330 'ASCII file -- this program does not check for this!!!
340 '
500 'Mainflow-control routine
510 PRINT : PRINT "ENTER NAME OF FILE TO BE COMPRESSED."
520 PRINT "MUST have extention .BAS (Do not give extention)."
530 PRINT "Result will be stored in <filename>.CMP ."
540 PRINT "(MUST have been stored as ASCII file):";
550 INPUT FILENAME$
560 PRINT : PRINT "ENTER LINE NUMBER OF FIRST LINE TO BE COMPRESSED."
570 PRINT "COMPRESS starts compression after this number is"
580 PRINT "reached or passed. You may respond with 0:";
590 INPUT START.LINE.NUMBER% : PRINT
600 OPEN FILENAME$+".BAS" FOR INPUT AS #1
610 OPEN FILENAME$+".CMP" FOR OUTPUT AS #2
620 WHILE NOT EOF(1)
630 OUTLINE$ = STRING$(255,0) : J% = 1
640 LINE INPUT#1, INLINE$
650 IF VAL(MID$(INLINE$,1, INSTR(INLINE$," "))) < START.LINE.NUMBER% THEN PRINT#2, INLINE$ : PRINT LEFT$(INLINE$, INSTR(INLINE$, " ")) : GOTO 710
660 I% = 1
670 WHILE I% <= LEN(INLINE$)
680 IF MID$(INLINE$,I%,1) = CHR$(34) THEN GOSUB 1000 ELSE GOSUB 2000 '1000 = in-quotes rtn; 2000 = out-of-quotes rtn
690 WEND
700 IF NOT MID$(OUTLINE$, (1 + INSTR(OUTLINE$," ")), 1) = "'" THEN PRINT#2, LEFT$(OUTLINE$,J%-1) : PRINT LEFT$(OUTLINE$, INSTR(OUTLINE$, " "))
710 WEND
720 BEEP : PRINT "COMPRESSED PROGRAM STORED AS "FILENAME$+".CMP" : END
730 '
1000 'In-quotes-preprocessing routine
1010 CHARS.TIL.NEXT.QUOTE% = INSTR(MID$(INLINE$,I%+1), CHR$(34))
1020 IF CHARS.TIL.NEXT.QUOTE% = 0 THEN CHARS.TIL.NEXT.QUOTE% = LEN(INLINE$) - I%
1030 MID$(OUTLINE$,J%, CHARS.TIL.NEXT.QUOTE% + 1) = MID$(INLINE$,I%, CHARS.TIL.NEXT.QUOTE% + 1)
1040 I% = I% + CHARS.TIL.NEXT.QUOTE% + 1
1050 J% = J% + CHARS.TIL.NEXT.QUOTE% + 1
1060 RETURN
1070 '
2000 'Out-of-quotes-preprocessing routine
2010 IF MID$(INLINE$, I%, 1) = "'" THEN MID$(OUTLINE$,J%,1) = "'" : J% = J% + ABS(J% = (1+INSTR(OUTLINE$," "))) : I% = I% + LEN(INLINE$) + 1 : GOTO 2050 'RETURN
2020 IF MID$(INLINE$, I%, 1) = " " AND MID$(INLINE$, I% + 1, 1) = " " THEN I% = I% + 1 : GOTO 2050 'RETURN
2030 'ELSE
2040 MID$(OUTLINE$, J%, 1) = MID$(INLINE$, I%, 1) : J% = J% + 1 : I% = I% + 1
2050 RETURN
CRC.TXT
PC-SIG Disk No. #47, version v1
The following is a list of the file checksums which should be produced by
the CRCK4 program on disk #9 (and others). If the CRC numbers do not match
you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: DISRTN .EXE CRC = 39 0B
--> FILE: CASTLE .BAS CRC = D4 B2
--> FILE: CASTLE .DOC CRC = CD 6E
--> FILE: NORMAL-Z.BAS CRC = 45 A8
--> FILE: COMPRESS.BAS CRC = 76 F2
--> FILE: MAILLIST.BAS CRC = 9A DC
--> FILE: GDUMP1 .BAS CRC = EF 3C
--> FILE: GDUMP2 .BAS CRC = 64 2C
--> FILE: ELECTRIC.BAS CRC = CE 58
--> FILE: SORT-BLK.BAS CRC = 4F E2
--> FILE: CHRONSET.BAS CRC = 58 08
--> FILE: COMCHRON.BAS CRC = A4 E5
--> FILE: FINPAK .BAS CRC = B3 A3
--> FILE: KILLNULL.BAS CRC = 8A 3E
--> FILE: PLOT .BAS CRC = 80 2F
--> FILE: XMAS .BAS CRC = DD A3
---------------------> SUM OF CRCS = 3C E3
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
ELECTRIC.BAS
10 DEFINT A:KEY OFF:'7/11/82 ELECTRIC
30 'WRITTEN BY MAURY SHULMAN 265 BOWMAN AVE MERION PA 19066
50 DIM A(1000)
90 CLS
100 PRINT"ELECTRIC BILL ANALYSIS PROGRAM":PRINT:PRINT:PRINT
200 PRINT:PRINT"ENTER FUNCTION DESIRED.":PRINT
300 PRINT:PRINT:PRINT"1. NEW BILL ENTRY."
400 PRINT:PRINT:PRINT"2. YEARLY ANALYSIS."
500 PRINT:PRINT:PRINT"3. MONTHLY ANALYSIS."
600 PRINT:PRINT:PRINT"4. SAVE PROGRAM ON DISKETTE."
700 LOCATE 24,1:INPUT Z:IF Z>4 OR Z<1 THEN BEEP:LOCATE 22,1:PRINT"INCORRECT ENTRY. ENTER 1,2,3 OR 4.":FOR A=1 TO 3000:NEXT:BEEP:GOTO 90
800 ON Z GOSUB 2000,10000,15000,20000
900 GOTO 90
1070 INPUT "ENTER YEAR OR 0 TO END";Y
2000 CLS:PRINT"ENTER DATA IN FORM OF MMYY,KWH,$,NO OF MONTHS IN THE BILLING PERIOD":PRINT:PRINT"MMYY IS THE DATE OF THE END OF THE BILLING PERIOD":PRINT"KWH IS THE NUMBER OF KILOWATT-HOURS BILLED":PRINT"$ IS THE TOTAT CHARGE IN CENTS (WITHOUT DECIMAL
2100 PRINT"N IS THE MONTHS IN THE BILLING PERIOD (USUALLY ONE)":PRINT:PRINT:PRINT"BILLING DATA IS STORED WITHIN THE PROGRAM IN THE FORM OF DATA STATEMENTS.":PRINT"MAKE SURE THAT YOU SAVE THIS PROGRAM AFTER EACH TIME THAT YOU ENTER DATA."
2200 PRINT"THIS CAN BE DONE BY USING THE END FUNCTION OF THIS PROGRAM."
2300 PRINT:PRINT"THIS PROGRAM IS SET UP FOR THE YEARS 1973 TO 1984. OTHER YEARS CAN BE ANAYZED BY CHANGING THE FOLLOWING LINE NUMBERS:":PRINT" 10100 10200 10700"
2500 PRINT:INPUT "PRESS ENTER FOR LISTING OF DATA STATEMENTS";R$:LIST 30000-
4000 P=1
4002 IF S THEN RETURN
4003 S=-1
4005 RESTORE
4010 FOR Z=1 TO 100:LOCATE 24,1:PRINT"C A L C U L A T I N G";
4020 FOR W=1 TO 4
4030 READ A(P)
4040 P=P+1
4050 NEXT
4060 IF A(P-1)<=1 THEN GOTO 4200
4070 F=P-1
4080 FOR V=1 TO A(F)-1
4090 A(P)=A(F-3)+V*100
4100 IF A(P)>=1300 THEN A(P)=A(P)-1199
4110 A(P+1)=A(F-2)/A(F)
4120 A(P+2)=A(F-1)/A(F)
4130 A(P+3)=A(F)
4140 P=P+4
4150 NEXT
4160 A(F-2)=A(F-2)/A(F)
4170 A(F-1)=A(F-1)/A(F)
4200 LOCATE 24,1:PRINT" ";: NEXT
4300 RETURN
10000 GOSUB 4000
10100 LOCATE 24,1:INPUT "WHAT YEAR DO YOU WANT ANALYZED YYYY";Y:CLS:IF Y>1984 OR Y<1973 THEN BEEP:PRINT"INCORRECT ENTRY. ENTER A YEAR BETWEEN 1973 AND 1984.":FOR AX=1 TO 3000:NEXT:BEEP:GOTO 10100
10200 N=Y-1973:K=0:D=0:U=0:X=0:KW=0:DD=0:RD=0
10220 PRINT"ELECTRIC BILL ANALYSIS":PRINT:PRINT"DATE KW-HRS $/MONTH CENTS/KW-HR KW % $ % RATE % ": PRINT
10300 FOR Q=1 TO 12
10400 M=48*N+4*(Q-1)
10430 IF A(M+2)<>0 THEN X=X+1:C=A(M+3)/A(M+2)ELSE C=0
10500 PRINT USING "####";A(M+1);:PRINT USING "######.##";A(M+2);A(M+3)/100;C;:IF KW>0 AND A(M+2)>0 THEN PRINT USING "########";(A(M+2)-KW)*100/KW;(A(M+3)-DD)*100/DD;(C-RD)*100/RD ELSE PRINT
10550 K=K+A(M+2):D=D+A(M+3)/100:U=U+C:KW=A(M+2):DD=A(M+3):RD=C
10600 NEXT
10650 PRINT:PRINT:PRINT"TOTAL";:PRINT USING "#####.##";K;:PRINT USING "######.##";D:PRINT:PRINT"AVG ";:PRINT USING "######.##";K/X;D/X;U/X
10700 LOCATE 24,1:INPUT "ENTER YEAR YYYY OR 0 TO END";Y:CLS:IF (Y>1984 OR Y<1973) AND Y<>0 THEN BEEP:PRINT"INCORRECT ENTRY. ENTER A YEAR BETWEEN 1973 AND 1984 OR 0 TO END.":FOR AX=1 TO 3000:NEXT:BEEP:GOTO 10700
10800 IF Y<>0 THEN GOTO 10200
10900 RETURN
15000 GOSUB 4000
15100 INPUT "WHAT MONTH DO YOU WANT ANALYZED? ENTER NUMBER...";N:IF N>12 OR N<1 THEN BEEP:PRINT:PRINT"INCORRECT INPUT. ENTER A NUMBER FROM 1 TO 12.":FOR AS=1 TO 3000:NEXT:BEEP:GOTO 15100
15125 CLS:KW=0:DD=0:RD=0
15130 PRINT"ELECTRIC BILL ANALYSIS":PRINT:PRINT"DATE KW-HRS $/MONTH CENTS/KW-HR KW % $ % RATE % ": PRINT
15150 FOR Q=1 TO 12
15200 M=4*(N-1)+1+48*(Q-1)
15250 IF A(M+1)<>0 THEN C=A(M+2)/A(M+1)ELSE C=0
15300 PRINT USING "####";A(M);:PRINT USING "######.##";A(M+1);A(M+2)/100;C;:IF KW>0 AND A(M+1)>0 THEN PRINT USING "########";(A(M+1)-KW)*100/KW;(A(M+2)-DD)*100/DD;(C-RD)*100/RD ELSE PRINT
15400 KW=A(M+1):DD=A(M+2):RD=C:NEXT
15500 LOCATE 24,1:INPUT " NUMBER OF MONTH OR 0 TO STOP";N:IF N>12 OR N<0 THEN BEEP:PRINT"INCORRECT ENTRY. ENTER A NUMBER FROM 0 TO 12.":FOR AX=1 TO 3000:NEXT:BEEP:GOTO 15500
15600 IF N<>0 THEN GOTO 15125
15700 RETURN
20000 D$="B:ELECTRIC":DB$="B:ELECTRIC.SAV":CLS:PRINT"THIS FUNCTION WILL SAVE THIS PROGRAM ON DISKETTE":PRINT:PRINT"DEFAULT PRIMARY FILE NAME IS ";D$:PRINT"BACKUP FILE NAME IS ";DB$:INPUT "ENTER FILE NAME OR <ENTER> FOR DEFAULT";R$:IF R$=""THEN R$=D$
20100 INPUT "ENTER BACKUP FILE NAME OR <ENTER> FOR DEFAULT";RR$:IF RR$=""THEN RR$=DB$:PRINT:PRINT"FILE NAME IS ";R$:PRINT"BACKUP FILE NAME IS ";RR$:PRINT:INPUT "IS THIS CORRECT REPLY Y OR N";RC$:IF RC$<>"Y" OR RC$<>"Y" THEN GOTO 20000
20200 SAVE R$:SAVE RR$:PRINT"PROGRAM SAVED.":GOTO 100
30000 DATA 173,1535,5369,3,473,1573,5647,3,773,3538,12472,3
30010 DATA 1073,1635,6020,3,174,1545,6410,3,474,1559,7806,3
30020 DATA 774,2876,13476,3,1074,1480,7418,3,175,1459,7948,3
30030 DATA 475,2209,11356,3,775,2668,14158,2,975,1112,5677,2
30040 DATA 1175,1404,7113,2,176,1278,6601,2,376,1433,7277,2
30050 DATA 576,1879,9621,2,776,2078,11348,2,976,1252,6565,2
30060 DATA 1176,1384,7295,2,177,1326,7376,2,377,1068,6105,2
30070 DATA 577,1457,8243,2,777,2693,16106,2,977,804,4644,1
30080 DATA 1077,599,3147,1,1177,802,4194,1,1277,844,4521,1
30090 DATA 178,739,4134,1,278,720,4125,1,378,746,4237,1
30100 DATA 478,545,3084,1,578,594,3278,1,678,951,5618,1
30110 DATA 778,1208,7212,1,878,1453,8617,1,978,754,4311,1
30120 DATA 1078,706,3778,1,1178,717,3874,1,1278,875,4669,1
30130 DATA 179,799,4279,1,279,820,4402,1,379,630,3658,1
30140 DATA 479,656,3789,1,579,753,4335,1,679,645,4220,1
30150 DATA 779,1139,7504,1,879,952,6547,1,979,844,6015,1
30160 DATA 1079,579,4320,1,1179,679,5220,1,1279,620,4933,1
30170 DATA 180,651,5149,1,280,774,5638,1,380,632,4651,1
30180 DATA 480,545,4046,1,580,626,4717,1,680,646,4993,1
30190 DATA 780,1351,11223,1,880,1001,8176,1,980,761,6083,1
30220 DATA 1080,624,4764,1,1180,727,5552,1,1280,660,5113,1
30230 DATA 181,636,4926,1,281,594,4599,1,381,614,4755,1
30240 DATA 481,631,5056,1,581,600,5168,1,681,735,6595,1
30250 DATA 781,1256,11697,1,881,738,6624,1,981,697,6214,1
30260 DATA 1081,659,5665,1,1181,665,5717,1,1281,711,6182,1
30270 DATA 182,646,5614,1,282,641,5571,1,382,670,5825,1
30280 DATA 482,572,4700,1,582,612,5413,1,682,660,6448,1
31000 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,00,0,00,0,0
31100 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,00,0,00,0,0
31200 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,00,0,00,0,0
31300 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,00,0,00,0,0
31400 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,00,0,00,0,0
31500 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,0,00,0,00,0,0
FINPAK.BAS
10 DIM Z$(5)
20 DIM M$(5)
21 PR$="####.##%"
22 V$="$$#,###,###,###.##"
23 I$="###.##%"
24 D$="--------------------------------------------------------------------------------"
25 KEY OFF
26 I2$="##"
27 Y$="Y":N$="N"
30 DEFDBL J,B,R,A,Q,P,T,Y
40 CLS
50 PRINT D$;
60 PRINT SPC(38);"MENU"
70 PRINT D$;
80 PRINT "(1) Future Value of Investment (11) Depreciated Investment"
90 PRINT
100 PRINT "(2) Future Value of Annuity (12) Salvage Value Year End"
110 PRINT
120 PRINT "(3) Future Value of Savings (13) Discounted Commercial Paper"
140 PRINT "(4) Withdrawals From Investment (14) Loan Principal"
150 PRINT
160 PRINT "(5) Minimum Investment for Income (15) Loan Payment Schedules"
170 PRINT
180 PRINT "(6) Income From Investments (16) Final Loan Payments"
185 PRINT
190 PRINT "(7) Nominal Interest Rates (17) Remaining Loan Balance"
200 PRINT
210 PRINT "(8) Effective Interest Rates (18) Loan Repayment Periods"
220 PRINT
230 PRINT "(9) Earned Interest Table (19) Loan Annual Interest Rate"
240 PRINT
250 PRINT "(10) Annual Depreciation Rate (20) Mortgage Amortization Table"
255 LOCATE 23,1,1
260 PRINT D$;
270 INPUT "Select a Program by Number (0 to Exit): ";Z
280 IF Z=0 THEN 5000
290 ON Z GOTO 330,510,690,880,1100,1330,1560,1780,1960,2030,2230,2420,2610
300 IF Z>14 THEN Z1=Z-13
310 ON Z1 GOTO 2820,2980,3170,3410,3670,3850,3910
320 GOTO 40
330 GOSUB 4500
340 PRINT" #1 Future Value of Investment":PRINT D$;
345 LOCATE 23,1:PRINT D$;
350 LOCATE 8,1:INPUT "Enter the Initial Value of Investment: ";P:LOCATE 8,63:PRINT USING V$;P
360 INPUT "Enter Nominal Interest Rate: ";I:LOCATE 10,63:PRINT USING I$;I
410 PRINT:INPUT "Enter Number of Compounding Periods Each Year: ";N:LOCATE 12,63:PRINT N
420 PRINT
430 INPUT "Enter Number of Years for the Investment: ";Y:LOCATE 14,63:PRINT Y
440 PRINT
450 I=I/N/100
460 T=P*(I+1)^(N*Y):PRINT:PRINT
470 PRINT"Future Value of This Investment is: ";:LOCATE 18,63:COLOR 15,8:PRINT USING V$;T:COLOR 7
480 LOCATE 25,1:INPUT "Want Another Future Value Calculation (Y or N): ";ANS$
490 IF LEFT$(ANS$,1)=Y$ THEN 330 ELSE 40
510 GOSUB 4500:PRINT" Future Value of Regular Deposits - Annunity":PRINT D$;
515 LOCATE 23,1:PRINT D$;
550 LOCATE 8,1:INPUT "Enter Amount of Regular Deposit: ";R
560 LOCATE 8,63:PRINT USING V$;R
570 LOCATE 10,1:INPUT "Enter Nominal Interest Rate: ";I:LOCATE 10,65:PRINT USING I$;I
590 PRINT:INPUT "Enter Number of Deposits Each Year: ";N:LOCATE 12,65:PRINT N
610 PRINT:INPUT "Enter the Number of Years: ";Y:LOCATE 14,65:PRINT Y
620 I=I/N/100
630 T=R*((I+1)^(N*Y)-1)/I
650 PRINT:PRINT "FUTURE VALUE IS: ";:LOCATE 16,63:COLOR 10,8:PRINT USING V$;T:COLOR 7
660 LOCATE 25,1:INPUT "Another Future Value Calculation (Y or N): ";ANS$
670 IF LEFT$(ANS$,1)="y" THEN 510 ELSE CLS: GOTO 40
690 GOSUB 4500
700 PRINT " Future Value of Annuity or Savings Account"
710 GOSUB 4510
720 LOCATE 8,1:INPUT "Enter Desired Future Value: ";T:LOCATE 8,63:PRINT USING V$;T
740 INPUT "Enter Nominal Interest Rate: ";I:LOCATE 10,63:PRINT USING I$;I
750 PRINT:INPUT "Enter Number of Deposits Per Year: ";N:LOCATE 12,63:PRINT N
780 PRINT:INPUT "Enter the Number of Years: ";Y:LOCATE 14,63:PRINT Y
790 I=I/N/100
800 R=T*I/((I+1)^(N*Y)-1)
802 R$=STR$(R):T$=STR$(T)
804 L1=LEN(R$):L2=LEN(T$)
810 PRINT:PRINT:PRINT"Regular deposits of: ";:COLOR 10,8:LOCATE 17,(22-(13-L1)):PRINT USING V$;R;:COLOR 7:PRINT" will yield:";:PRINT USING V$;T:PRINT" in: ";Y;" years"
820 LOCATE 25,1:INPUT "Another run (Y or N): ";ANS$
830 IF LEFT$(ANS$,1)="Y" THEN 690 ELSE 40
880 GOSUB 4500:PRINT" Regular Wuthdrawals from an Investment":PRINT D$:LOCATE 23,1:PRINT D$;
910 LOCATE 8,1:INPUT "Enter the amount of your initial investment: ";P:LOCATE 8,63:PRINT USING V$;P
920 INPUT "Enter nominal interest rate: ";I:LOCATE 10,63:PRINT I
940 PRINT:INPUT "Enter the number of withdrawals each year: ";N:LOCATE 12,63:PRINT N
950 PRINT:INPUT "Enter the number of years: ";Y:LOCATE 14,63:PRINT Y
970 I=I/N/100
980 R=P*(I/((I+1)^(N*Y)-1)+I)
990 LOCATE 18,1:PRINT"You may withdraw: ";:COLOR 15:PRINT USING V$;R;:COLOR 7:PRINT" from your account: ";N:PRINT"times per year for : ";Y;" years without reducing your initial investment"
1070 LOCATE 24,1:INPUT "Do you want another calculation (Y or N): ";ANS$
1080 IF ANS$="Y" THEN 880 ELSE 40
1100 GOSUB 4500:PRINT" INVESTMENT REQUIRED TO PROVIDE FUTURE VALUE":GOSUB 4510
1110 LOCATE 8,1:INPUT "Enter amount you wish to end up with: ";T:LOCATE 8,63:PRINT USING V$;T
1120 INPUT "Enter the number of compounding periods each year: ";N:LOCATE 10,63:PRINT N
1130 PRINT:INPUT "Enter the number of years for this investment: ";Y:LOCATE 12,63:PRINT Y
1140 PRINT:INPUT "Enter the nominal interest rate: ";I:LOCATE 14,63:PRINT I
1220 I1=I
1230 I=I/N/100
1240 P=T/(I+1)^(N*Y)
1250 LOCATE 18,1:PRINT"You must invest: ";:COLOR 15:PRINT USING V$;P;:COLOR 7:PRINT" to yield: ";:PRINT USING V$;T
1260 LOCATE 24,1:INPUT "Do you want to make another calculation: ";ANS$
1270 IF ANS$="Y" THEN 1100 ELSE 40
1330 GOSUB 4500:PRINT" MINIMUM INVESTMENT FOR INCOME";:PRINT D$:LOCATE 23,1:PRINT D$;:LOCATE 8,1
1380 INPUT "Enter number of withdrawals each year: ";N:LOCATE 8,63:PRINT USING V$;Y
1390 INPUT "Enter amount of each withdrawal: ";R:LOCATE 10,63:PRINT USING V$;R
1420 INPUT "Enter the nominal interest rate: ";I:LOCATE 12,63:PRINT USING I$;I
1430 PRINT:INPUT "Withdrawal to occur for how many years: ";Y:LOCATE 14,63:PRINT Y
1450 I1=I
1460 I=I/100
1470 P=R*N/I*(1-1/((1+I/N)^(N*Y)))
1490 LOCATE 18,1:PRINT"A minimum investment of: ";:COLOR 15:PRINT USING V$;P;:COLOR 7:PRINT" will yeild your desired return"
1500 LOCATE 24,1:INPUT "Do you want another calculation (Y or N): ";ANS$
1510 IF ANS$="Y" THEN 1330 ELSE 40
1560 CLS:PRINT D$:PRINT" NOMINAL INTEREST ON INVESTMENTS:":PRINT D$:LOCATE 23,1:PRINT D$;
1570 LOCATE 8,1:INPUT "Enter the amount of the principal: ";P:LOCATE 8,63:PRINT USING V$;P
1580 INPUT "Enter total amount of investment: ";T:LOCATE 10,63:PRINT USING V$;T
1630 INPUT "Enter the number of years of the investment: ";Y:LOCATE 12,63:PRINT Y
1670 PRINT:INPUT "Enter the comounding periods each year: ";N:LOCATE 14,63:PRINT N
1680 I2=N*((T/P)^(1/(N*Y))-1)*100
1700 LOCATE 18,1:PRINT "The nominal interest rate for the above parameters is: ";:COLOR 15:PRINT I2;:COLOR 7
1710 LOCATE 25,1:INPUT "Do you want another calculation (Y or N): ";ANS$
1720 IF ANS$="Y" THEN 1560 ELSE 40
1780 GOSUB 4500:PRINT" EFFECTIVE INTEREST ON INVESTMENTS";:GOSUB 4510
1830 LOCATE 8,1:INPUT "Enter the amount of the initial investment";P:LOCATE 8,63:PRINT USING V$;P
1850 INPUT "Enter the desired future value: ";T:LOCATE 10,63:PRINT USING V$;T
1870 INPUT "Enter the life of the investment in years";Y:LOCATE 12,72:PRINT Y;"Years"
1880 A=((T / P) ^ (1 / Y) - 1) * 100
1900 LOCATE 14,1:PRINT"The effective annual interest rate of the investment is:";:COLOR 10,8:PRINT USING PR$;A:COLOR 7
1930 LOCATE 25,1:INPUT "Do you want to run another (Y or N): ";ANS$:IF LEFT$(ANS$,1)=Y$ THEN 1780 ELSE 40
1940 PRINT : IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 1780
1950 GOTO 40
1960 REM EARNED INTEREST TABLE
1970 CLS:PRINT D$
1980 PRINT "#9 EARNED INTEREST TABLE FOR INVESTMENT"
1990 PRINT
2000 PRINT D$
2010 PRINT " ******** UNDER CONSTRUCTION ********"
2020 FOR I = 1 TO 2000: NEXT I: GOTO 40
2030 REM DEPRECIATION RATE ON INVESTMENT
2040 GOSUB 4500
2050 PRINT " ANNUAL DEPRECIATION RATE OF AN INVESTMENT"
2060 GOSUB 4510
2080 LOCATE 8,1:INPUT "Enter the Original Price of the Item";P:LOCATE 8,63:PRINT USING V$;P
2100 INPUT "Enter the Resale Price of the Item";T:LOCATE 10,63:PRINT USING V$;T
2120 INPUT "Enter the Item's Life in Years";Y:LOCATE 12,73:PRINT USING I2$;Y;:PRINT" Years"
2140 D = 100 * (1 - (T / P) ^ (1 / Y))
2160 LOCATE 16,1:PRINT "If You Purchased This Item for:";:PRINT USING V$;P;:PRINT" and Sold it ";:PRINT USING I2$;Y;:PRINT" Years Later-"
2180 PRINT "for: ";:PRINT USING V$;T;:PRINT", the Actual Depreciation Rate is: ";:COLOR 10,8:PRINT USING PR$;D:COLOR 7
2200 LOCATE 25,1:INPUT "Another Run (Y or N): ";ANS$
2210 IF LEFT$ (ANS$,1) = "Y" THEN 2040 ELSE 40
2230 REM CALCULATE THE AMOUNT OF DEPREC OF AN ITEM
2240 GOSUB 4500
2250 PRINT " AMOUNT DEPRECIATED WITHIN A YEAR"
2260 GOSUB 4510
2270 LOCATE 8,1:INPUT "Enter the Original Price of the Item:";P:LOCATE 8,63:PRINT USING V$;P
2280 PRINT
2290 K = 100
2300 INPUT "WHAT PERCENT DO YOU WANT TO DEPRECIATE";I
2310 PRINT
2320 I = I / 100
2330 PRINT : FOR Y = 1 TO K
2340 D = P * I * (1 - I) ^ (Y - 1)
2350 PRINT "YEAR #";Y;"DEPRECIATION IS $"; D: PRINT
2360 X = X + 1: IF X = 5 THEN X = 0
2370 PRINT "PRESS RETURN FOR MORE": INPUT X$: PRINT
2380 IF D > = 2 THEN NEXT Y
2390 PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
2400 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 2230
2410 GOTO 40
2420 CLS:PRINT D$
2430 PRINT " #12 CALCULATE THE SALVAGE VALUE"
2440 PRINT " OF AN ITEM..."
2450 PRINT D$
2460 INPUT "ENTER THE ORIGINAL PRICE OF THE ITEM";P
2470 PRINT
2480 INPUT "ENTER THE ITEM'S DEPRECIATION RATE";I
2490 PRINT
2500 K = 100
2510 FOR Y = 1 TO K
2520 S = P * (1 - I / 100) ^ Y
2530 PRINT "YEAR #";Y;"SALVAGE VALUE IS $";S
2540 PRINT
2550 X = X + 1: IF X = 5 THEN X = 0
2560 PRINT "PRESS RETURN FOR MORE": INPUT X$: PRINT
2570 IF S > = 2 THEN NEXT Y
2580 PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
2590 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 2420
2600 GOTO 40
2610 REM FIND AMOUNT OF DISC PAPER
2620 CLS:PRINT D$
2630 PRINT "#13 CALCULATE THE NET COST OF DISCOUNTED"
2640 PRINT " PAPER.."
2650 PRINT D$
2660 PRINT
2670 INPUT "ENTER THE FUTURE VALUE OF THE NOTE";T
2680 INPUT "ENTER THE DISCOUNT RATE";D
2690 PRINT
2700 INPUT "ENTER THE NUMBER OF DAYS TO MATURITY";N
2710 D = D / 100
2720 D1 = T * D * N / 360
2730 PRINT
2740 PRINT "IF YOU PURCHASE A NOTE WORTH $";T
2750 PRINT " DUE IN";N;"DAYS"
2760 PRINT "AT A DISCOUNT RATE OF";D * 100;"PERCENT,"
2770 PRINT "THE DISCOUNT AMOUNT WILL BE $";D1
2780 PRINT "AND THE COST WILL BE $";T - D1;" ."
2790 PRINT : PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
2800 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 2610
2810 GOTO 40
2820 CLS:PRINT D$
2830 PRINT TAB( 5)"#14 PRINCIPAL ON A LOAN"
2840 PRINT
2850 PRINT D$
2860 INPUT "HOW MANY PAYMENTS DO YOU MAKE EACH YEAR";N
2870 PRINT
2880 INPUT "WHAT IS THE AMOUNT OF EACH PAYMENT";R
2890 PRINT
2900 INPUT "WHAT IS THE LOAN ANNUAL INTEREST RATE";I
2910 PRINT
2920 INPUT "ENTER THE LIFE OF THE LOAN IN YEARS";Y
2930 P = R * N * (1 - 1 / ((I / 100) / N + 1) ^ (N * Y)) / (I / 100)
2940 PRINT:PRINT "The principal on this loan is: "; USING "$$#,###,###.##";P
2950 PRINT : PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
2960 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 2820
2970 GOTO 40
2980 CLS:PRINT D$
2990 PRINT " #15 REGULAR PAYMENT ON A LOAN.."
3000 PRINT
3010 PRINT D$
3020 PRINT "WHAT IS THE LIFE OF THE LOAN IN YEARS"
3030 INPUT Y
3040 INPUT"WHAT IS TRHE ANNUAL INTEREST RATE ";I
3050 INPUT "HOW MANY PAYMENTS DO YOU MAKE EACH YEAR";N
3060 INPUT "WHAT IS THE LOAN PRINCIPAL AMOUNT";P
3070 PRINT : PRINT :R = ((I / 100) * P / N) / (1 - 1 / ((I / 100) / N + 1) ^ (N * Y))
3080 I1 = I
3090 PRINT "Regular payments of "; USING "$$#,###,###.##";R;
3100 PRINT " made ";N;" times each year"
3110 PRINT "are required to satisfy"
3120 PRINT "a loan of "; USING "$$#,###,###.##";P;: PRINT " for a period of "; USING "###";Y;: PRINT" years"
3130 PRINT "at an interest rate of";I1;" pecent per annum."
3140 PRINT : PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
3150 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 2980
3160 GOTO 40
3170 CLS:PRINT D$
3180 PRINT TAB( 10)"#16 LAST PAYMENT ON A LOAN"
3190 PRINT
3200 PRINT D$
3210 INPUT "WHAT IS THE LIFE OF THE LOAN IN YEARS";Y
3220 INPUT "ENTER THE ANNUAL INTEREST RATE";I
3230 PRINT
3240 INPUT "WHAT IS THE AMOUNT OF EACH REGULAR PAYMENT";R
3250 PRINT
3260 INPUT "HOW MANY PAYMENTS DO YOU MAKE EACH YEAR";N
3270 PRINT
3280 INPUT "ENTER THE AMOUNT OF THE LOAN PRINCIPAL";P
3290 PRINT :I1 = I:I = I / 100:BO = P
3300 IF N * Y > 100 THEN PRINT TAB( 20)"WORKING THE PROBLEM"
3310 FOR J1 = 1 TO N * Y
3320 I2 = INT ((BO * I / N) * 100 + .5) / 100
3330 A = R - I2
3340 BO = BO - A
3350 NEXT J1
3360 PRINT "THE LAST PAYMENT FOR THIS LOAN,"
3370 PRINT "WILL BE $"; INT ((R + BO) * 100 + .5) / 100
3380 PRINT : PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
3390 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 3170
3400 GOTO 40
3410 CLS:PRINT D$
3420 PRINT " #17 REMAINING BALANCE ON A LOAN"
3430 PRINT
3440 PRINT D$
3450 INPUT "ENTER THE NUMBERS OF PAYMENTS MADE EACH YEAR";N
3460 PRINT
3470 INPUT "ENTER THE ANNUAL INTEREST RATE";I
3480 PRINT
3490 INPUT "WHAT IS THE AMOUNT OF EACH PAYMENT";R
3500 PRINT
3510 INPUT "WHAT IS THE AMOUNT OF THE LOAN PRINCIPAL";P
3520 PRINT
3530 PRINT "ENTER THE LAST PAYMENT MADE ,"
3540 INPUT " (PAYMENT #, YEAR # )";N1,Y
3550 PRINT : PRINT "WORKING ON PROBLEM"
3560 I = I / 100
3570 BO = P
3580 FOR J1 = 1 TO N * (Y - 1) + N1
3590 I1 = INT ((BO * I / N) * 100 + .5) / 100
3600 A = R - I1
3610 BO = BO - A
3620 NEXT J1
3630 PRINT : PRINT "THE REMAINING BALANCE IS $"; INT (BO * 100 + .5) / 100
3640 PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
3650 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 3410
3660 GOTO 40
3670 CLS:PRINT D$
3680 PRINT TAB( 10)"THE TERM OF A LOAN"
3690 PRINT
3700 PRINT D$
3710 INPUT "ENTER THE NUMBER OF PAYMENTS EACH YEAR";N
3720 PRINT
3730 INPUT "ENTER THE ANNUAL INTEREST RATE";I
3740 PRINT
3750 INPUT "WHAT IS THE AMOUNT OF EACH REGULAR PAYMENT";R
3760 PRINT
3770 INPUT "WHAT IS THE AMOUNT OF THE LOAN PRINCIPAL";P
3780 PRINT
3790 Y = - ( LOG (1 - (P * (I / 100)) / (N * R)) / ( LOG (1 + I / 100 / N) * N))
3800 PRINT "A TERM OF"; INT (Y * 10 + .5) / 10;"YEARS WILL SATISFY THIS LOAN."
3810 PRINT "SATISFY THIS SCHEDULE."
3820 PRINT : INPUT "DO YOU WANT TO RUN ANOTHER (Y/N)";Y$
3830 IF LEFT$ (Y$,1) = "Y" THEN GOSUB 4370: GOTO 3670
3840 GOTO 40
3850 CLS:PRINT D$
3860 PRINT "#19 THE ANNUAL INTEREST RATE ON A LOAN"
3870 PRINT D$
3880 PRINT " ******** UNDER CONSTRUCTION ********"
3890 FOR I = 1 TO 2000: NEXT I
3900 GOTO 40
3910 CLS:PRINT D$
3920 PRINT " THE MORTGAGE AMORTIZATION TABLE"
3930 PRINT
3940 PRINT " COMPUTE INTEREST PAYMENTS..."
3950 PRINT
3960 PRINT D$
3970 PRINT D$
3980 REM LEADING & TRAILING ZERO'S NOT ?"ED"
3990 C = 0
4000 INPUT "Enter Amount of Loan";A
4010 INPUT "Amount of Interest in Percent";J
4020 INPUT "Nunber of Years";N
4030 J = J / 100
4040 N = N * 12:I = J / 12:B = 1 + I:R = A * I / (1 - 1 / B ^ N)
4050 PRINT "Amount per Payment =";USING"$$,###,###.##";R
4060 Q = (R * N - A)
4080 PRINT "Total Interest=";USING"$$,###,###.##";Q
4090 PRINT "To Begin Listing Hit Any Key...":F=0
4100 A$=INKEY$
4110 IF A$="" THEN 4100
4120 PRINT :B = A
4130 GOSUB 4370
4140 PRINT "PMT INTEREST PRINCIPAL BALANCE"
4150 C = C + 1:L = B * I:P = R - L:B = B - P:IF B<0 THEN B=0
4160 PRINT USING"###";C;:PRINT USING"$$,###,###.##";L;P;B
4170 F = F + 1
4180 IF F = 20 THEN 4280
4190 IF N>C THEN 4150
4200 D=R+B
4230 PRINT "Last Payment was...";USING"$$,###,###.##";D
4240 INPUT "Do You Want to Run Another (Y/N)";Y$
4250 IF LEFT$ (Y$,1) = "Y" THEN 3910 ELSE 40
4280 PRINT"TO CONTINUE STRIKE ANY KEY, ESC TO STOP"
4290 A$=INKEY$: IF A$="" THEN 4290
4300 IF A$=CHR$(27) THEN GOSUB 4370: GOTO 4240
4310 PRINT
4320 F = 0
4330 GOSUB 4370
4340 GOTO 4140
4370 CLS:RETURN
4380 CLS:RETURN
4390 REM
4500 CLS:PRINT D$;:RETURN
4510 PRINT D$;:LOCATE 23,1:PRINT D$;:RETURN
4999 STOP
5000 CLS:LOCATE 12,39:COLOR 16,7:PRINT"Bye":PLAY"C11D11E11D6E11C4":COLOR 7:LOCATE 23,1:END
8880 A=((T / P) ^ (1 / Y) - 1) * 100
GDUMP1.BAS
20 B7%=128:B6%=64:B5%=32:B4%=16:B3%=8:B2%=4:B1%=2:B0%=1
30 LPRINT CHR$(27)"@": WIDTH "LPT1:",255
40 DIM X%(8),B%(320)
50 FOR Y% = 0 TO 191 STEP 8
60 FOR X% = 0 TO 319
70 FOR I% = 0 TO 7
80 X%(I%) = POINT(X%, Y%+I%): IF X%(I%)=3 THEN X%(I%)=1
90 NEXT I%
100 B%(X%)=X%(0)*B7%+X%(1)*B6%+X%(2)*B5%+X%(3)*B4%+X%(4)*B3%+X%(5)*B2%+X%(6)*B1%+X%(7)*B0%
110 NEXT X%
120 LPRINT CHR$(27);"K";CHR$(63);CHR$(1);
130 FOR J%= 0 TO 319
140 LPRINT CHR$(B%(J%));
150 NEXT J%
160 LPRINT CHR$(27) "A" CHR$(8)
170 NEXT Y%
180 END
GDUMP2.BAS
10 CLEAR
20 B7%=128:B6%=64:B5%=32:B4%=16:B3%=8:B2%=4:B1%=2:B0%=1
30 LPRINT CHR$(27)"@": WIDTH "LPT1:",255
40 DIM X%(8),B%(650)
50 FOR Y%= 0 TO 191 STEP 8
60 FOR X%= 0 TO 639
70 FOR I%= 0 TO 7
80 X%(I%) = POINT(X%, Y%+I%)
90 NEXT I%
100 B%(X%)=X%(0)*B7%+X%(1)*B6%+X%(2)*B5%+X%(3)*B4%+X%(4)*B3%+X%(5)*B2%+X%(6)*B1%+X%(7)*B0%
110 NEXT X%
120 LPRINT CHR$(27);"L";CHR$(127);CHR$(2);
130 FOR J%= 0 TO 639
140 LPRINT CHR$((B%(J%)));
150 NEXT J%
160 LPRINT CHR$(27) "A" CHR$(8)
170 NEXT Y%
180 END
KILLNULL.BAS
10 INPUT "Name of file";OLD$
20 OPEN OLD$ FOR INPUT AS #1
30 OPEN "NEW" FOR OUTPUT AS #2
40 IF EOF(1) THEN 90
50 A$=INPUT$(1,#1)
60 IF A$=CHR$(0) THEN 40
70 PRINT #2,A$;
80 GOTO 40
90 CLOSE
100 NAME OLD$ AS "OLDFILE.BAK"
110 NAME "NEW" AS OLD$
120 END
MAILLIST.BAS
100 ' MAILLIST by Bob Noble
110 ' IBM Personal Computer BASIC
120 '
130 ' Submitted to the Philadelphia IBM PC Users Club 6-30-82
140 '
150 ' This program creates, appends, edits, displays, and deletes
160 ' variable length records of 10 variable length fields in
170 ' "Mailling List" type files named by the user.
180 '
190 ' The biggest deficiency is the lack of an LPRINT routine for
200 ' printing hard copy. This is because I don't yet have a print-
210 ' er myself. I leave the addition of this function to other
220 ' programers, or until I get a printer.
230 '
240 ' Variables Used
250 ' FILE$ = Name of data file used
260 ' L$ = Name (Last Name of person)
270 ' F$ = First Name of person
280 ' A$ = 1st Next Line
290 ' B$ = 2nd Next Line (optional)
300 ' D$ = 3rd Next Line (optional)
310 ' E$ = 4th Next Line (optional)
320 ' G$ = 5th Next Line (optional)
330 ' C$ = City
340 ' S$ = State
350 ' Z$ = Zip Code
360 '
370 CLS: KEY OFF: LINE INPUT "Enter name of file to be used: ", FILE$
380 '
390 ' Main menu
400 '
410 CLS: PRINT "MAILLIST * * * MAIN MENU File Open: "; FILE$
420 PRINT: PRINT " 1. Add Record(s)"
430 PRINT " 2. Edit Record(s)"
440 PRINT " 3. Display Record(s)"
450 PRINT " 4. Delete Record(s)"
460 PRINT " 5. Task Completed - Return to BASIC"
470 PRINT: INPUT "Make Selection (1-5): ", Q
480 IF Q=5 THEN CLOSE: CLS: KEY ON: END
490 ON Q GOTO 520, 990, 760, 1220
500 '
510 ' * * * * * Data Entry Module
520 OPEN FILE$ FOR APPEND AS #1
530 CLS: PRINT "MAILLIST *** DATA ENTRY File Open: "; FILE$
540 LOCATE 19,10: PRINT "Note: If name is not a person, enter as last name and
550 PRINT " press <ENTER> when `first name' prompt appears."
560 LOCATE 3,1: LINE INPUT " Last Name: ", L$
570 LINE INPUT " First Name: ", F$
580 LOCATE 22,10: PRINT "Note: Press `%' at `Next Line' prompt when ready to enter `city'."
590 LOCATE 5,1: LINE INPUT " Next Line: ", A$
600 LINE INPUT " Next Line: ", B$
610 IF B$ = "%" THEN D$ = "%": E$ = "%": G$ = "%": GOTO 670
620 LINE INPUT " Next Line: ", D$
630 IF D$ = "%" THEN E$ = "%": G$ = "%": GOTO 670
640 LINE INPUT " Next Line: ", E$
650 IF E$ = "%" THEN G$ = "%": GOTO 670
660 LINE INPUT " Next Line: ", G$
670 LINE INPUT " City: ", C$
680 LINE INPUT " State: ", S$
690 LINE INPUT " Zip: ", Z$
700 WRITE#1, L$,F$,A$,B$,D$,E$,G$,C$,S$,Z$
710 '
720 PRINT: LINE INPUT "Do you want to enter more data? (Y/N) ", Q$
730 IF LEFT$(Q$,1)="Y" OR LEFT$(Q$,1)="y" THEN 530 ELSE CLOSE: GOTO 410
740 '
750 ' * * * * * Display File
760 CLS: OPEN "I", 1, FILE$
770 PRINT "MAILLIST * * * Display Routine File Open: "; FILE$
780 PRINT: PRINT "1. Display one record at a time."
790 PRINT "2. Scroll file."
800 PRINT: LINE INPUT "Make Selection (1 or 2): ", Q$
810 CLS
820 LOCATE 25: PRINT "Press <ENTER> to continue.": LOCATE 1
830 IF EOF(1) THEN 950
840 INPUT#1, L$,F$,A$,B$,D$,E$,G$,C$,S$,Z$
850 IF F$="" THEN PRINT L$: GOTO 870
860 PRINT F$ + " " + L$
870 PRINT A$
880 IF B$ <> "%" THEN PRINT B$
890 IF D$ <> "%" THEN PRINT D$
900 IF E$ <> "%" THEN PRINT E$
910 IF G$ <> "%" THEN PRINT G$
920 PRINT C$ + ", " + S$ + " " + Z$
930 IF Q$="2" THEN PRINT: GOTO 830
940 INPUT "",Q$: GOTO 830
950 PRINT "END OF FILE ": LOCATE 25,18: INPUT "return to main menu ",Q$
960 CLOSE: GOTO 410
970 '
980 ' * * * * * Edit File
990 CLS: OPEN "I", 1, FILE$
1000 OPEN "O", 2, "TEMPFIL"
1010 PRINT "MAILLIST * * * Edit Routine File Open: "; FILE$
1020 PRINT: LINE INPUT "Enter last name of record to edit: ", L$
1030 IF LEN(L$) = 0 THEN PRINT "Something must be entered.": GOTO 1020
1040 '
1050 GOSUB 1630: ' * * * Search Subroutine
1060 '
1070 CLS: PRINT "MAILLIST * * * Edit Routine File Open: "; FILE$
1080 GOSUB 1540: ' * * * Display record for field to edit
1090 PRINT: INPUT "Enter selection (0-10): ", Q
1100 IF Q=0 THEN WRITE #2, L1$,F$,A$,B$,D$,E$,G$,C$,S$,Z$: GOTO 1140
1110 LOCATE 17: PRINT "Make changes and move cursor to end of line, then press <ENTER>.": LOCATE 1
1120 ON Q GOSUB 1420,1430,1440,1450,1460,1470,1480,1490,1500,1510
1130 '
1140 GOSUB 1720: ' * * Subroutine to read-write remainder of file to TEMPFIL
1150 '
1160 GOSUB 1770: ' * Subroutine to initialize and copy TEMPFIL back to file
1170 '
1180 ' * * * * * Querry user for more editing
1190 LOCATE 19: LINE INPUT "Do you want to do more editing? (Y/N) ", Q$
1200 IF LEFT$(Q$,1)="Y" OR LEFT$(Q$,1)="y" THEN 990 ELSE 410
1210 '
1220 ' * * * * * Delete Record Routine
1230 CLS: PRINT "MAILLIST * * * Delete Record Routine File Open: "; FILE$
1240 PRINT: LINE INPUT "Enter last name of record to delete: ", L$
1250 OPEN "I", 1, FILE$: OPEN "O", 2, "TEMPFIL"
1260 '
1270 GOSUB 1630: ' * * * Search subroutine
1280 '
1290 CLS: PRINT "MAILLIST * * * Delete Record Routine File Open: "; FILE$
1300 GOSUB 1540: ' * Subroutine to display record
1310 PRINT: LINE INPUT "Enter `0' to delete record, or `1' to save: ", Q$
1320 IF Q$ = "0" THEN GOSUB 1720: ' * * * Write rest of FILE$ to TEMPFIL
1330 IF Q$="1" THEN WRITE #2,L$,F$,A$,B$,D$,E$,G$,C$,S$,Z$: GOSUB 1720: 'ditto
1340 GOSUB 1770: ' * * * Write TEMPFIL back to FILE$
1350 '
1360 ' * * * * * Querry user for more deletions
1370 PRINT: LINE INPUT "Do you want to delete another? ", Q$
1380 IF LEFT$(Q$,1) = "Y" OR LEFT$(Q$,1) = "y" THEN 1230 ELSE 410
1390 '
1400 ' * * * * * Subroutines to edit fields
1410 '
1420 LOCATE 4,5: LINE INPUT L$: GOSUB 1600: RETURN: ' *** Last Name
1430 LOCATE 5,5: LINE INPUT F$: GOSUB 1600: RETURN: ' *** First Name
1440 LOCATE 6,5: LINE INPUT A$: GOSUB 1600: RETURN: ' *** 1st `Next Line'
1450 LOCATE 7,5: LINE INPUT B$: GOSUB 1600: RETURN: ' *** 2nd `Next Line'
1460 LOCATE 8,5: LINE INPUT D$: GOSUB 1600: RETURN: ' *** 3rd `Next Line'
1470 LOCATE 9,5: LINE INPUT E$: GOSUB 1600: RETURN: ' *** 4th `Next Line'
1480 LOCATE 10,5: LINE INPUT G$: GOSUB 1600: RETURN: ' *** 5th `Next Line'
1490 LOCATE 11,5: LINE INPUT C$: GOSUB 1600: RETURN: ' *** City
1500 LOCATE 12,5: LINE INPUT S$: GOSUB 1600: RETURN: ' *** State
1510 LOCATE 13,5: LINE INPUT Q$: GOSUB 1600: RETURN: ' *** Zip Code
1520 '
1530 ' * * * * * Subroutine to Display Field Menu
1540 PRINT: PRINT " 0 = No Changes"
1550 PRINT " 1. "; L$: PRINT " 2. "; F$: PRINT " 3. "; A$: PRINT " 4. "; B$
1560 PRINT " 5. "; D$: PRINT " 6. "; E$: PRINT " 7. "; G$: PRINT " 8. "; C$
1570 PRINT " 9. "; S$: PRINT "10. "; Z$
1580 '
1590 ' * * * * * Subroutine to write edited record to file
1600 WRITE #2, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: RETURN
1610 '
1620 ' * * * * * File Search Subroutine
1630 IF EOF(1) THEN 1670
1640 INPUT #1, L1$, F$, A$, B$, D$, E$, G$, C$, S$, Z$
1650 IF L$ = L1$ THEN RETURN
1660 WRITE #2, L1$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: GOTO 1630
1670 PRINT: PRINT "ERROR Message. "; V$; " not found in "; FILE$
1680 PRINT: LINE INPUT "Press <ENTER> to return to main menu. ", Q$
1690 CLOSE: GOTO 410
1700 '
1710 ' * * * * * Subroutine to read-write remainder of file to TEMPFIL
1720 IF EOF(1) THEN CLOSE: RETURN
1730 INPUT #1, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$
1740 WRITE #2, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: GOTO 1720
1750 '
1760 ' * * * * * Subrountine to initialize and copy TEMPFIL back to file
1770 OPEN "I", 1, "TEMPFIL": OPEN "O", 2, FILE$
1780 IF EOF(1) THEN CLOSE: KILL "TEMPFIL": RETURN
1790 INPUT #1, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$
1800 WRITE #2, L$, F$, A$, B$, D$, E$, G$, C$, S$, Z$: GOTO 1780
NORMAL-Z.BAS
100 '**********************************************************************
110 '******** ***********
120 '******** NORMAL DISTRIBUTION ROUTINES ***********
130 '******** ***********
140 '**********************************************************************
150 ' * COPYRIGHT 1982 - CRAIG W. UTHE *
160 ' * WRITTEN 3/3/82 BY CRAIG W. UTHE *
170 ' * * * * * *
180 ' * ANY INDIVIDUAL MAY COPY THIS PROGRAM *
190 ' * AND MAKE MODIFICATIONS TO IT IF THAT *
200 ' * INDIVIDUAL ARRANGES TO CONTRIBUTE ONE *
210 ' * OTHER PROGRAM TO THE PHILA. AREA IBM *
215 ' * PC USER GROUP PUBLIC DOMAIN SOFTWARE *
220 ' * EXCHANGE LIBRARY. HOWEVER, COPIES *
230 ' * ARE NOT ALLOWED TO BE SOLD, NOT IN *
240 ' * WHOLE NOR IN PART, NOT SEPARATELY *
250 ' * NOR JOINTLY WITH OTHER SOFTWARE. *
260 ' *********************************************
270 '
280 '
1000 'MASTER-CONTROL ROUTINE
1010 CLS
1020 PRINT "This program computes areas under the normal distribution"
1030 PRINT "probability curve from the mean to a designated `Z' value."
1040 PRINT "This program also can compute `Z' values from a given area."
1050 PRINT
1060 PRINT "Just as in most statistical tables, only half the curve is
1070 PRINT "considered. Z values must be between -4 and +4 (these"
1080 PRINT "limits are somewhat arbitrary) and area figures must be"
1090 PRINT "between 0 and 0.5 (actually .49997). If out-of-range"
1100 PRINT "figures are input, the nearest range limit is assumed"
1110 PRINT "instead."
1120 PRINT
1130 PRINT "HIT ANY KEY TO START"
1140 SELECTION$ = INKEY$ : IF SELECTION$ = "" THEN GOTO 1140 'SAME LINE
1150 ' Area results (given Z) are accurate to the 5 displayed digits.
1160 ' Z values are accurate to 2 digits based on an input area,
1170 ' or the 3 displayed digits based on the program's approximation
1180 ' of that area.
1190 '
1200 ' This precision can be changed by changing the precision
1210 ' constants in the program from their 0.000001 setting.
1220 ' For higher precision, you might also want to change the
1230 ' variables to double, instead of single, precision form.
1240 ' With higher precision, you may wish to change the number
1250 ' of digits displayed, too.
1260 '
1270 ' Out of respect, please do not mutilate the structured
1280 ' programming approach that makes changes so easy and
1290 ' makes the program almost readable. Of course you can
1300 ' easily use the subroutines in more elaborate programs.
1310 ' This program is fairly insignificant by itself.
1320 '
1330 SELECTION$ = "1" 'initialization
1340 WHILE (SELECTION$ = "1" OR SELECTION$ = "2")
1350 CLS : PRINT STRING$(60,42)
1360 PRINT : PRINT "MENU:"
1370 PRINT : PRINT " <1> . . . . . . . . COMPUTE AREA FROM Z"
1380 PRINT : PRINT " <2> . . . . . . . . COMPUTE Z VALUE FROM AREA"
1390 PRINT : PRINT " <ANY OTHER KEY> . . EXIT PROGRAM"
1400 PRINT : PRINT STRING$(60,45)
1410 PRINT : PRINT "HIT ANY KEY IN INDICATED RANGE TO MAKE SELECTION:"
1420 SELECTION$ = INKEY$ : IF SELECTION$ = "" THEN GOTO 1420 'SAME LINE
1430 CLS : PRINT "THANK YOU."
1440 IF 0 = INSTR("12",SELECTION$) THEN : PRINT "I HOPE THE PROGRAM WAS USEFUL TO YOU. BYE." : GOTO 1480 'WEND
1450 ON INSTR("12",SELECTION$) GOSUB 3000,2000
1460 'IE: IF 1, GOSUB COMPUTE-Z-FROM-AREA ROUTINE
1470 ' IF 2, GOSUB COMPUTE-AREA-FROM-Z ROUTINE
1480 WEND
1490 END
1500 '
1510 '
2000 'COMPUTE-Z-FROM-AREA ROUTINE
2010 PRINT : PRINT STRING$(80,42) : PRINT
2020 QUIT% = 0
2030 WHILE NOT QUIT%
2040 PRINT "INPUT AREA VALUE FROM WHICH TO COMPUTE FREQUENCY."
2050 PRINT "(ENTRIES OVER 5.0 CAUSE RETURN TO MENU.)"
2060 INPUT "INPUT AREA VALUE (0 TO 0.49997): ",AREA
2070 IF AREA > 5 THEN QUIT% = -1 : GOTO 2230 'WEND
2080 HI.CALCULATED.AREA = .49997 : HI.Z = 4 '*** area < .49997
2090 LO.CALCULATED.AREA = 0 : LO.Z = 0 '*** area > 0
2100 IF AREA >= .49997 THEN CALCULATED.AREA = .49997 : Z = 4 : GOTO 2170
2110 IF AREA <= 0 THEN CALCULATED.AREA = 0 : Z = 0 : GOTO 2170 'PRNT
2120 WHILE ABS(CALCULATED.AREA - AREA) > .000001
2130 IF AREA > CALCULATED.AREA THEN LO.CALCULATED.AREA = CALCULATED.AREA : LO.Z = Z ELSE HI.CALCULATED.AREA = CALCULATED.AREA : HI.Z = Z
2140 Z = (LO.Z + HI.Z) / 2
2150 GOSUB 4000 'McLAUREN-METHOD-AREA-CALCULATION ROUTINE
2160 WEND
2170 PRINT : PRINT "THE NORMAL-DISTRIBUTION Z-VALUE CORRESPONDING"
2180 PRINT "TO A MEAN-TO-Z AREA OF ";
2190 PRINT USING "#.#####"; CALCULATED.AREA;
2200 PRINT " is: ";
2210 PRINT USING "#.###"; Z
2220 PRINT : PRINT STRING$(80,42) : PRINT
2230 WEND
2240 RETURN
2250 '
3000 'COMPUTE-AREA-FROM-Z ROUTINE
3010 PRINT : PRINT STRING$(80,42) : PRINT
3020 QUIT% = 0
3030 WHILE NOT QUIT%
3040 PRINT "INPUT Z VALUE FROM WHICH TO COMPUTE FREQUENCY."
3050 PRINT "(ENTRIES OVER 5.0 CAUSE RETURN TO MENU.)"
3060 INPUT "INPUT Z VALUE (-4.0 TO +4.0): ", Z
3070 IF Z >= 5 THEN QUIT% = -1 : GOTO 3150 'WEND
3080 IF ABS(Z) >= 4 THEN CALCULATED.AREA = .49997 : Z.SGN% = SGN(Z) : Z = 4 :GOTO 3100 'PRINT OUTPUT
3090 GOSUB 4000 'McLAUREN-METHOD-AREA-CALCULATION ROUTINE
3100 PRINT :PRINT "THE AREA UNDER THE NORMAL DISTRIBUTION CURVE"
3110 PRINT "FROM THE MEAN TO Z = " Z.SGN%*Z " IS: ";
3120 PRINT USING "#.#####"; CALCULATED.AREA
3130 PRINT
3140 PRINT : PRINT STRING$(80,42) : PRINT
3150 WEND
3160 RETURN
3170 '
4000 'McLAUREN-METHOD-AREA-CALCULATION ROUTINE
4010 '
4020 Z.SGN% = SGN(Z) : Z = ABS(Z) : Z.SQR = Z*Z
4030 CALCULATED.AREA = Z * (1/SQR(2*3.141592654#))
4040 Z.CONSTANT = CALCULATED.AREA
4050 PRECISION.ERROR = 1 : INTERMEDIATE.TERM = 1 : I% = 1
4060 '
4070 WHILE ABS(PRECISION.ERROR) > .000001
4080 INTERMEDIATE.TERM = -(INTERMEDIATE.TERM * Z.SQR) / (2*I%)
4090 PRECISION.ERROR = Z.CONSTANT * (INTERMEDIATE.TERM / (2*I% + 1))
4100 CALCULATED.AREA = CALCULATED.AREA + PRECISION.ERROR
4110 I% = I% + 1
4120 WEND
4130 CALCULATED.AREA = CALCULATED.AREA - PRECISION.ERROR
4140 RETURN
PLOT.BAS
10 SCREEN 2
40 INPUT " xmin, xmax, increment ";X1,X2,X4
50 INPUT "ymin, ymax, increment ";Y1,Y2,Y4
55 CLS
60 X5 = - ((X1/(X2-X1))*635)+2
61 IF X1 < 0 AND X2 < 0 THEN X5 =637
62 IF X1> 0 AND X2 > 0 THEN X5 = 2
70 Y5=((Y2/(Y2-Y1))*195)+2
71 IF Y1 < 0 AND Y2< 0 THEN Y5 = 2
72 IF Y1 >0 AND Y2 > 0 THEN Y5 = 197
80 LINE (X5,Y5) - (X5,2)
90 LINE (X5,Y5 )-(X5,197)
100 LINE (X5,Y5)-(2,Y5)
110 LINE (X5,Y5)-(637,Y5)
120 FOR X3=X5 TO 637 STEP 634 * (X4/(X2- X1))
130 IF X3>637 THEN 160
140 LINE (X3, Y5 -2)-( X3,Y5 +2)
150 NEXT X3
160 FOR X3 = X5 TO 2 STEP -635 *(X4/(X2-X1))
170 IF X3 <2 THEN 200
180 LINE (X3,Y5 - 2 )-(X3,Y5 +2)
190 NEXT X3
200 FOR Y3 = Y5 TO 197 STEP 195 *(Y4/(Y2-Y1))
220 IF Y3 > 195 THEN 250
230 LINE (X5-2,Y3) - (X5 +2,Y3 )
240 NEXT Y3
250 FOR Y3 = Y5 TO 2 STEP - 195 * (Y4 /(Y2 - Y1 ))
260 IF Y3 < 2 THEN 290
270 LINE (X5 - 2, Y3 ) - (X5 +2, Y3)
280 NEXT Y3
281 INPUT " start, finish, increment " ;X1,X2,X6
284 X=X1
290 Y= SIN(X)
430 PSET((X-X1)*(635/(X2-X1))+2,(-Y +Y2)*(195/(Y2-Y1))+2)
431 X=X+X6
435 IF X<X2 THEN 290 ELSE 460
460 END
SORT-BLK.BAS
100 ' SORT-BLK.BAS by Bob Noble, Philadelphia IBM PC Users Club
110 ' Submitted 8-21-82.
120 '
130 ' This program must be altered for the programmer's specific application.
140 ' The data file to be operated on must be a fixed-field-length, random-
150 ' access type, and the record size must be a multiple of 128 bytes. If
160 ' not specified in the OPEN statement, the default is 128.
170 '
180 ' The file used in this version is called ARTICLES. It has 61 fields tot-
190 ' aling 363 bytes (e.g. the record size is 128*3 = 384). Note that when
200 ' more fields are needed than can fit in a single 256 byte FIELD state-
210 ' ment, dummy variables with parameters <= 256 must be used at the begin-
220 ' ing of each sucessive FIELD statement.
230 '
240 ' The file is blocked so that each group of 16 records contains 13 act-
250 ' ual records followed by an overflow space of 3 null records. The first
260 ' 2 bytes of a null record are "@@".
270 '
280 ' The key being sorted is the "Headline" field AF$. The arrays are loaded
290 ' with the first 32 characters of the key field in each actual record,
300 ' nulls are skipped. The sort used is a popular binary one. A new sorted
310 ' and blocked file is created. The original is killed and the new file
320 ' is renamed to the original.
330 '
340 ' This program would be used as part of a system. A data entry program
350 ' would put new records in the proper overflow space via an alphabetic
360 ' search. Every time an overflow space becomes full, the file must be
370 ' sorted and reblocked.
380 '
390 ' Significant improvements in disk space utilization, and time may be
400 ' achieved by creating a separate index file consisting of the first
410 ' 32 bytes of each key and a pointer to the record in which it resides.
420 ' Then the data file itself would not have to be blocked or sorted.
430 '
440 ' I am intent on learning all ISAM, and other useful data management
450 ' techniques. I will continue to submit what I develope as long as
460 ' there is an interest. Please contact me with questions or help.
470 ' (215) 329-4205 5431 North 12th Street
480 ' Philadelphia, PA 19141
490 '
500 CLEAR: CLS: OPEN "R", 1, "B:ARTICLES", 384
510 FIELD 1, 155 AS AF$, 5 AS BF$, 8 AS CF$, 45 AS DF$, 5 AS LLF$, 11 AS EF$, 1 AS FF$, 1 AS GF$, 1 AS HF$, 1 AS IIF$, 1 AS JF$, 1 AS KF$, 1 AS LF$, 1 AS MF$, 1 AS NF$, 1 AS OF$, 1 AS PF$, 1 AS CQF$
520 FIELD 1, 241 AS ZZ1$, 1 AS RF$, 1 AS SF$, 1 AS TF$, 1 AS UF$, 1 AS VF$, 1 AS WF$, 1 AS XF$, 1 AS YF$, 1 AS ZF$, 1 AS AAF$, 1 AS ABF$, 1 AS ACF$, 1 AS ADF$, 1 AS AEF$, 1 AS CAFF$, 1 AS AGF$, 1 AS AHF$
530 FIELD 1, 129 AS ZZ2$, 129 AS ZZ3$, 1 AS AIF$, 1 AS AJF$, 1 AS AKF$, 1 AS ALF$, 1 AS AMF$, 1 AS ANF$, 1 AS AOF$, 1 AS APF$, 1 AS AQF$, 1 AS ARF$, 1 AS ASF$, 1 AS ATF$, 1 AS AUF$, 1 AS AVF$, 1 AS AWF$
540 FIELD 1, 137 AS ZZ4$, 136 AS ZZ5$, 1 AS AXF$, 1 AS AYF$, 1 AS AZF$, 1 AS BAF$, 1 AS BBF$, 1 AS BCF$, 1 AS BDF$, 1 AS BEF$, 1 AS CBFF$, 1 AS BGF$, 75 AS BHF$
550 '
560 PRINT "ARTICLES *** SORT AND BLOCK ROUTINE"
570 PRINT: PRINT "PRESS ANY KEY TO START SORT"
580 Q$ = INKEY$: IF Q$="" THEN 580
590 '
600 ' ***************************************
610 ' ************ Load Arrays ************
620 ' ***************************************
630 '
640 PRINT: PRINT "AS NUMBERS APPROACH 0, TASKS NEAR END" TAB(66) "TIME"
650 PRINT: PRINT "LOADING ARRAYS FROM ORIGINAL FILE ------------------------>"
660 K = LOF(1)/384: V=K: I%=0: T=0: TIME$="00:00:00"
670 DIM ZZ$(K), R(K)
680 FOR X=1 TO K
690 V=V-1: LOCATE 7,60: PRINT V
700 I%=I%+1: IF I%=K+1 THEN 740 ELSE GET 1,I%
710 IF LEFT$(AF$,2)="@@" THEN 700
720 T=T+1: ZZ$(T) = LEFT$(AF$,32): R(T)=I%
730 NEXT
740 TI1$=TIME$: LOCATE 7,64: PRINT TI1$
750 '
760 ' ***************************************
770 ' ************ Shell Sort *************
780 ' ***************************************
790 '
800 CLOSE
810 V=0: LOCATE 7,60: PRINT V: PRINT: PRINT "SORT STARTED --------------------------------------------->": M=T: TIME$="00:00:00"
820 M=INT(M/2): LOCATE 9,60: PRINT M: IF M=0 THEN 930 ELSE P=T-M: J=1
830 N=J
840 L=N+M
850 GOSUB 1210 ' *** Determine A1$ and B1$
860 IF ASC(A1$) > ASC(B1$) THEN SWAP ZZ$(N),ZZ$(L): SWAP R(N),R(L): N=N-M: IF N>=1 THEN 840
870 J=J+1: IF J>P THEN 820 ELSE 830
880 '
890 ' ****************************************
900 ' * Create new sorted and blocked file *
910 ' ****************************************
920 '
930 TI2$=TIME$: LOCATE 9,64: PRINT TI2$
940 LOCATE 11,1: PRINT "SORT ENDED - NOW CREATING NEW SORTED AND BLOCKED FILE ---->"
950 I%=0: D=14: C=T: TIME$="00:00:00": GOSUB 1520 ' *** Open Files
960 FOR Y=1 TO T: C=C-1: LOCATE 11,60: PRINT C
970 I%=I%+1: IF I%=D THEN D=D+16: GOSUB 1680 ' ****** Skip 3 records
980 GET 1,R(Y): GOSUB 1340 ' ************************* LSET variables
990 PUT 2,I%
1000 NEXT Y
1010 TI3$=TIME$: LOCATE 11,64: PRINT TI3$
1020 '
1030 GOSUB 1780 ' ***** Determine Total Time
1040 '
1050 PRINT: PRINT "TOTAL TIME ="; TH; "HOURS"; TM; "MINUTES"; TS; "SECONDS"
1060 '
1070 ' ***************************************
1080 ' *************** End *****************
1090 ' ***************************************
1100 '
1110 CLOSE: KILL "B:ARTICLES": NAME "B:ARTICLE" AS "B:ARTICLES"
1120 '
1130 PRINT: PRINT "PROGRAM OVER - PRESS ANY KEY TO RETURN TO MAIN MENU"
1140 Q$=INKEY$: IF Q$="" THEN 1140
1150 RUN "ART-MAIN.BAS"
1160 '
1170 ' *****************************************
1180 ' * Subroutine to determine A1$ and B1$ *
1190 ' *****************************************
1200 '
1210 H=1: S=1
1220 A1$ = MID$(ZZ$(N),H,1): B1$ = MID$(ZZ$(L),S,1)
1230 IF MID$(ZZ$(N),H,2)=" " THEN A1$="AAAAAAAA"
1240 IF MID$(ZZ$(L),S,2)=" " THEN B1$="AAAAAAAA"
1250 IF ASC(A1$)>64 AND ASC(A1$)<91 THEN 1260 ELSE H=H+1: GOTO 1220
1260 IF ASC(B1$)>64 AND ASC(B1$)<91 THEN 1270 ELSE S=S+1: GOTO 1220
1270 IF ASC(A1$)=ASC(B1$) THEN H=H+1: S=S+1: GOTO 1220
1280 RETURN
1290 '
1300 ' ****************************************
1310 ' **** Subroutine to LSET variables ****
1320 ' ****************************************
1330 '
1340 LSET AF$=A$:LSET BF$=B$:LSET CF$=C$:LSET DF$=D$:LSET LLF$=LL$:LSET EF$=E$
1350 LSET FF$=F$:LSET GF$=G$:LSET HF$=H$:LSET IIF$=II$:LSET JF$=J$:LSET KF$=K$
1360 LSET LF$=L$:LSET MF$=M$:LSET NF$=N$:LSET OF$=O$:LSET PF$=P$:LSET CQF$=CQ$
1370 LSET RF$=R$:LSET SF$=S$:LSET TF$=T$:LSET UF$=U$:LSET VF$=V$:LSET WF$=W$
1380 LSET XF$=X$:LSET YF$=Y$:LSET ZF$=Z$:LSET AAF$=AA$:LSET ABF$=AB$
1390 LSET ACF$=AC$:LSET ADF$=AD$:LSET AEF$=AE$:LSET CAFF$=CAF$:LSET AGF$=AG$
1400 LSET AHF$=AH$:LSET AIF$=AI$:LSET AJF$=AJ$:LSET AKF$=AK$:LSET ALF$=AL$
1410 LSET AMF$=AM$:LSET ANF$=AN$:LSET AOF$=AO$:LSET APF$=AP$:LSET AQF$=AQ$
1420 LSET ARF$=AR$:LSET ASF$=AS$:LSET ATF$=AT$:LSET AUF$=AU$:LSET AVF$=AV$
1430 LSET AWF$=AW$:LSET AXF$=AX$:LSET AYF$=AY$:LSET AZF$=AZ$:LSET BAF$=BA$
1440 LSET BBF$=BB$:LSET BCF$=BC$:LSET BDF$=BD$:LSET BEF$=BE$:LSET CBFF$=CBF$
1450 LSET BGF$=BG$:LSET BHF$=BH$
1460 RETURN
1470 '
1480 ' ****************************************
1490 ' ****** Subroutine to open files ******
1500 ' ****************************************
1510 '
1520 OPEN "R", 1, "B:ARTICLES", 384
1530 FIELD 1, 155 AS A$, 5 AS B$, 8 AS C$, 45 AS D$, 5 AS LL$, 11 AS E$, 1 AS F$, 1 AS G$, 1 AS H$, 1 AS II$, 1 AS J$, 1 AS K$, 1 AS L$, 1 AS M$, 1 AS N$, 1 AS O$, 1 AS P$, 1 AS CQ$
1540 FIELD 1, 241 AS ZZ1$, 1 AS R$, 1 AS S$, 1 AS T$, 1 AS U$, 1 AS V$, 1 AS W$, 1 AS X$, 1 AS Y$, 1 AS Z$, 1 AS AA$, 1 AS AB$, 1 AS AC$, 1 AS AD$, 1 AS AE$, 1 AS CAF$, 1 AS AG$, 1 AS AH$
1550 FIELD 1, 129 AS ZZ2$, 129 AS ZZ3$, 1 AS AI$, 1 AS AJ$, 1 AS AK$, 1 AS AL$, 1 AS AM$, 1 AS AN$, 1 AS AO$, 1 AS AP$, 1 AS AQ$, 1 AS AR$, 1 AS AS$, 1 AS AT$, 1 AS AU$, 1 AS AV$, 1 AS AW$
1560 FIELD 1, 137 AS ZZ4$, 136 AS ZZ5$, 1 AS AX$, 1 AS AY$, 1 AS AZ$, 1 AS BS$, 1 AS BB$, 1 AS BC$, 1 AS BD$, 1 AS BE$, 1 AS CBF$, 1 AS BGF$, 75 AS BHF$
1570 OPEN "R", 2, "B:ARTICLE", 384
1580 FIELD 2, 155 AS AF$, 5 AS BF$, 8 AS CF$, 45 AS DF$, 5 AS LLF$, 11 AS EF$, 1 AS FF$, 1 AS GF$, 1 AS HF$, 1 AS IIF$, 1 AS JF$, 1 AS KF$, 1 AS LF$, 1 AS MF$, 1 AS NF$, 1 AS OF$, 1 AS PF$, 1 AS CQF$
1590 FIELD 2, 241 AS ZZ1$, 1 AS RF$, 1 AS SF$, 1 AS TF$, 1 AS UF$, 1 AS VF$, 1 AS WF$, 1 AS XF$, 1 AS YF$, 1 AS ZF$, 1 AS AAF$, 1 AS ABF$, 1 AS ACF$, 1 AS ADF$, 1 AS AEF$, 1 AS CAFF$, 1 AS AGF$, 1 AS AHF$
1600 FIELD 2, 129 AS ZZ2$, 129 AS ZZ3$, 1 AS AIF$, 1 AS AJF$, 1 AS AKF$, 1 AS ALF$, 1 AS AMF$, 1 AS ANF$, 1 AS AOF$, 1 AS APF$, 1 AS AQF$, 1 AS ARF$, 1 AS ASF$, 1 AS ATF$, 1 AS AUF$, 1 AS AVF$, 1 AS AWF$
1610 FIELD 2, 137 AS ZZ4$, 136 AS ZZ5$, 1 AS AXF$, 1 AS AYF$, 1 AS AZF$, 1 AS BAF$, 1 AS BBF$, 1 AS BCF$, 1 AS BDF$, 1 AS BEF$, 1 AS CBFF$, 1 AS BGF$, 75 AS BHF$
1620 RETURN
1630 '
1640 ' **************************************
1650 ' *** Subroutine to Skip 3 Records ***
1660 ' **************************************
1670 '
1680 FIELD 1, 2 AS XYZ$: FIELD 2, 2 AS XYZF$
1690 FOR X=1 TO 3
1700 GET 1,1: XYZ$="@@": LSET XYZF$=XYZ$: PUT 2,I%: I%=I%+1
1710 NEXT X
1720 FIELD 1, 155 AS A$: FIELD 2, 155 AS AF$: RETURN
1730 '
1740 ' ********************************************
1750 ' *** Subroutine to Determine Total Time ***
1760 ' ********************************************
1770 '
1780 H1=VAL(LEFT$(TI1$,2)): M1=VAL(MID$(TI1$,4,2)): S1=VAL(RIGHT$(TI1$,2))
1790 H2=VAL(LEFT$(TI2$,2)): M2=VAL(MID$(TI2$,4,2)): S2=VAL(RIGHT$(TI2$,2))
1800 H3=VAL(LEFT$(TI3$,2)): M3=VAL(MID$(TI3$,4,2)): S3=VAL(RIGHT$(TI3$,2))
1810 TSEC = (3600*(H1+H2+H3)) + (60*(M1+M2+M3)) + S1 + S2 + S3
1820 TH=INT(TSEC/3600):TM=INT((TSEC-TH*3600)/60):TS=TSEC-(TH*3600)-(TM*60)
1830 RETURN
XMAS.BAS
10 COLOR 5,1,2
20 CLS
30 WIDTH 80
40 LOCATE 3,1
50 PRINT "O come all ye faithful, joyful and triumphant
60 LOCATE 6,1
70 PRINT "O come ye, O come ye to Bethlehem
80 LOCATE 9,1
90 PRINT "Come and behold him, born the king of angels
100 LOCATE 12,1
110 PRINT "O come let us adore him, O come let us adore him
120 LOCATE 15,1
130 PRINT "O come let us adore him, Christ the Lord.
140 LOCATE 2,1
150 PRINT CHR$(14)
160 PLAY "T240 L32 ML"
170 PLAY "O2 A O3 C+ E A O2 A O3 c+ e a" ' O
180 PLAY "O2 A O3 C+ E A P8
190 LOCATE 2,3
200 PRINT CHR$(14)
210 LOCATE 2,1
220 PRINT " "
230 PLAY "O2 A O3 C+ E A O2 A O3 C+ E A" ' come
240 PLAY "O2 A O3 C+ E A O2 A O3 C+ E A"
250 PLAY "O2 A O3 C+ E A O2 A O3 C+ E A
260 PLAY "O2 A O3 C+ E A O2 A O3 C+ E A
270 LOCATE 2,8
280 PRINT CHR$(14)
290 LOCATE 2,3
300 PRINT " "
310 PLAY "O2 A O3 C+ E16 O2 A O3 C+ E16"' all
320 PLAY "O2 A O3 C+ E16 O2 A O3 C+ E16
330 LOCATE 2,12
340 PRINT CHR$(14)
350 LOCATE 2,8
360 PRINT " "
370 PLAY "O2 A O3 C+ E A O2 A O3 C+ E A"' ye
380 PLAY "O2 A O3 C+ E A O2 A O3 C+ E A
390 LOCATE 2,15
400 PRINT CHR$(14)
410 LOCATE 2,12
420 PRINT " "
430 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B"' faith-
440 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B
450 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B
460 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B
470 PLAY "O2 G+ B O3 E16 O2 G+ B O3 E16"' ful
480 PLAY "O2 G+ B O3 E16 O2 G+ B O3 E16
490 PLAY "O2 G+ B O3 E16 O2 G+ B O3 E16
500 PLAY "O2 G+ B O3 E16 P8
510 LOCATE 2,15
520 PRINT " "
530 LOCATE 2,25
540 PRINT CHR$(14)
550 PLAY "O2 A16 O3 E O4 C+ O2 A16 O3 E O4 C+"' joy-
560 PLAY "O2 A16 O3 E O4 C+ O2 A16 O3 E O4 C+
570 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B"' ful
580 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B
590 LOCATE 2,25
600 PRINT " "
610 LOCATE 2,32
620 PRINT CHR$(14)
630 PLAY "O2 A16 O3 E O4 C+ O2 A16 O3 E O4 C+"'and
640 PLAY "O2 A16 O3 E O4 C+ O2 A16 O3 E O4 C+
650 LOCATE 2,32
660 PRINT " "
670 LOCATE 2,36
680 PRINT CHR$(14)
690 PLAY "O2 D A O3 F+ O4 D O2 D A O3 F+ O4 D"'tri-
700 PLAY "O2 D A O3 F+ O4 D O2 D A O3 F+ O4 D
710 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+"'um-
720 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+
730 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+
740 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+
750 PLAY "O2 E G+ O3 E B O2 E G+ O3 E B"' phant
760 PLAY "O2 E G+ O3 E B P8
770 LOCATE 2,36
780 PRINT " "
790 LOCATE 5,1
800 PRINT CHR$(14)
810 PLAY "O2 F+ A O3 C+ A O2 F+ A O3 C+ A"' O
820 PLAY "O2 F+ A O3 C+ A P8
830 LOCATE 5,1
840 PRINT " "
850 LOCATE 5,3
860 PRINT CHR$(14)
870 PLAY "O2 F+ A O3 C+ A O2 F+ A O3 C+ A"' come
880 PLAY "O2 F+ A O3 C+ A O2 F+ A O3 C+ A
890 PLAY "O2 F+ A O3 D+ A O2 F+ A O3 D+ A
900 PLAY "O2 F+ A O3 D+ A O2 F+ A O3 D+ A
910 LOCATE 5,3
920 PRINT " "
930 LOCATE 5,8
940 PRINT CHR$(14)
950 PLAY "O2 E B O3 E G+ O2 E B O3 E G+"' ye
960 PLAY "O2 E B O3 E G+ O2 E B O3 E G+
970 LOCATE 5,8
980 PRINT " "
990 LOCATE 5,12
1000 PRINT CHR$(14)
1010 PLAY "O1 B O2 B O3 D+ F+ O1 B O2 B O3 D+ F+ "' O
1020 PLAY "O1 B O2 B O3 D+ F+ O1 B O2 B O3 D+ F+
1030 LOCATE 5,12
1040 PRINT " "
1050 LOCATE 5,14
1060 PRINT CHR$(14)
1070 PLAY "O2 E B O3 E G+ O2 E B O3 E G+ "' come
1080 PLAY "O2 E B O3 E G+ O2 E B O3 E G+
1090 PLAY "O2 C+ A O3 E A O2 C+ A O3 E A
1100 PLAY "O2 C+ A O3 E A O2 C+ A O3 E A
1110 LOCATE 5,14
1120 PRINT " "
1130 LOCATE 5,19
1140 PRINT CHR$(14)
1150 PLAY "O1 G+ O2 G+ O3 E B O1 G+ O2 G+ O3 E B"' ye
1160 PLAY "O1 G+ O2 G+ O3 E B O1 G+ O2 G+ O3 E B
1170 LOCATE 5,19
1180 PRINT " "
1190 LOCATE 5,22
1200 PRINT CHR$(14)
1210 PLAY "O1 A O2 F+ O3 E O4 C+ O1 A O2 F+ O3 E O4 C+ "'to
1220 PLAY "O1 A O2 F+ O3 E O4 C+ O1 A O2 F+ O3 E O4 C+
1230 LOCATE 5,22
1240 PRINT " "
1250 LOCATE 5,25
1260 PRINT CHR$(14)
1270 PLAY "O1 B O2 B O3 E G+ O1 B O2 B O3 E G+ "' Beth-
1280 PLAY "O1 B O2 B O3 E G+ O1 B O2 B O3 E G+
1290 PLAY "O1 B O2 B O3 E G+ O1 B O2 B O3 E G+
1300 PLAY "O1 B O2 B O3 E G+ O1 B O2 B O3 E G+
1310 PLAY "O1 B O2 A O3 D+ F+ O1 B O2 A O3 D+ F+
1320 PLAY "O1 B O2 A O3 D+ F+ O1 B O2 A O3 D+ F+
1330 PLAY "O1 B O2 A O3 D+ F+ O1 B O2 A O3 D+ F+"' le-
1340 PLAY "O1 B O2 A O3 D+ F+ E16. P32
1350 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16"' hem
1360 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16
1370 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16
1380 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16
1390 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16
1400 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16
1410 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16
1420 PLAY "P4
1430 LOCATE 5,25
1440 PRINT " "
1450 LOCATE 8,1
1460 PRINT CHR$(14)
1470 PLAY "O3 C+16 E O4 E O3 C+16 E O4 E"' Come
1480 PLAY "O3 C+16 E O4 E O3 C+16 E O4 E
1490 PLAY "O3 C+16 E O4 E O3 C+16 E O4 E
1500 PLAY "O3 C+16 E O4 E O3 C+16 E O4 E
1510 LOCATE 8,1
1520 PRINT " "
1530 LOCATE 8,6
1540 PRINT CHR$(14)
1550 PLAY "O2 B O3 D F+ O4 D O2 B O3 D G+ O4 D"' and
1560 PLAY "O2 B O3 D F+ O4 D O2 B O3 D G+ O4 D
1570 LOCATE 8,6
1580 PRINT " "
1590 LOCATE 8,10
1600 PRINT CHR$(14)
1610 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+ "' be-
1620 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+
1630 PLAY "O2 B O3 D A O4 D O2 B O3 D A O4 D"' hold
1640 PLAY "O2 B O3 D A O4 D O2 B O3 D A O4 D
1650 PLAY "O2 B O3 D G+ O4 D O2 B O3 D G+ O4 D
1660 PLAY "O2 B O3 D G+ O4 D O2 B O3 D G+ O4 D
1670 LOCATE 8,10
1680 PRINT " "
1690 LOCATE 8,17
1700 PRINT CHR$(14)
1710 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+ "' him
1720 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+
1730 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+
1740 PLAY "O2 A O3 E A O4 C+ P8
1750 LOCATE 8,17
1760 PRINT " "
1770 LOCATE 8,22
1780 PRINT CHR$(14)
1790 PLAY "O2 G+ O3 E16 B O2 G+ O3 E16 B"' born
1800 PLAY "O2 G+ O3 E16 B O2 G+ O3 E16 B
1810 LOCATE 8,22
1820 PRINT " "
1830 LOCATE 8,27
1840 PRINT CHR$(14)
1850 PLAY "O2 A16 O3 E O4 C+ O2 A16 O3 E O4 C+ "' the
1860 PLAY "O2 A16 O3 E O4 C+ O2 A16 O3 E O4 C+
1870 LOCATE 8,27
1880 PRINT " "
1890 LOCATE 8,31
1900 PRINT CHR$(14)
1910 PLAY "O2 F+ O3 C+ F+ A O2 F+ O3 C+ F+ A"' King
1920 PLAY "O2 F+ O3 C+ F+ A O2 F+ O3 C+ F+ A
1930 LOCATE 8,31
1940 PRINT " "
1950 LOCATE 8,36
1960 PRINT CHR$(14)
1970 PLAY "O2 D O3 D F+ B O2 D O3 D F+ B"' of
1980 PLAY "O2 D O3 D F+ B O2 D O3 D F+ B
1990 LOCATE 8,36
2000 PRINT " "
2010 LOCATE 8,39
2020 PRINT CHR$(14)
2030 PLAY "O2 E B O3 E G+ O2 E B O3 E G+ "' An-
2040 PLAY "O2 E B O3 E G+ O2 E B O3 E G+
2050 PLAY "O2 E B O3 E G+ O2 E B O3 E G+
2060 PLAY "O2 E A O3 E F+ O2 E A O3 E F+
2070 PLAY "O2 E G+ O3 E16 O2 E G+ O3 E16"' gels
2080 PLAY "O2 E G+ O3 E16 P8
2090 LOCATE 8,39
2100 PRINT " "
2110 LOCATE 11,1
2120 PRINT CHR$(14)
2130 PLAY "O3 C+16 A16 C+16 A16"' O
2140 PLAY "O3 C+16 A16 P8
2150 LOCATE 11,1
2160 PRINT " "
2170 LOCATE 11,3
2180 PRINT CHR$(14)
2190 PLAY "C+16 A16 C+16 A16"' come
2200 PLAY "C+16 A16 C+16 A16
2210 LOCATE 11,3
2220 PRINT " "
2230 LOCATE 11,8
2240 PRINT CHR$(14)
2250 PLAY "O2 B16 O3 G+16 O2 B16 O3 G+16"' let
2260 PLAY "O2 B16 O3 G+16 O2 B16 O3 G+16
2270 LOCATE 11,8
2280 PRINT " "
2290 LOCATE 11,12
2300 PRINT CHR$(14)
2310 PLAY "C+16 A16 C+16 A16"' us
2320 PLAY "C+16 A16 C+16 A16
2330 LOCATE 11,12
2340 PRINT " "
2350 LOCATE 11,15
2360 PRINT CHR$(14)
2370 PLAY "D16 B16 D16 B16"' a-
2380 PLAY "D16 B16 D16 B16
2390 PLAY "C+16 A16 C+16 A16"' dore
2400 PLAY "C+16 A16 C+16 A16
2410 PLAY "C+16 A16 C+16 A16
2420 PLAY "C+16 A16 C+16 A16
2430 LOCATE 11,15
2440 PRINT " "
2450 LOCATE 11,21
2460 PRINT CHR$(14)
2470 PLAY "C+16 E16 C+16 E16"' him
2480 PLAY "C+16 E16 P8
2490 LOCATE 11,21
2500 PRINT " "
2510 LOCATE 11,26
2520 PRINT CHR$(14)
2530 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16"' O
2540 PLAY "O2 A O3 E O4 C+16 P8
2550 LOCATE 11,26
2560 PRINT " "
2570 LOCATE 11,28
2580 PRINT CHR$(14)
2590 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16"' come
2600 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16
2610 LOCATE 11,28
2620 PRINT " "
2630 LOCATE 11,33
2640 PRINT CHR$(14)
2650 PLAY "O2 G+ O3 E B16 O2 G+ O3 E B16"' let
2660 PLAY "O2 G+ O3 E B16 O2 G+ O3 E B16
2670 LOCATE 11,33
2680 PRINT " "
2690 LOCATE 11,37
2700 PRINT CHR$(14)
2710 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16"' us
2720 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16
2730 LOCATE 11,37
2740 PRINT " "
2750 LOCATE 11,40
2760 PRINT CHR$(14)
2770 PLAY "O2 B O3 E O4 D16 O2 B O3 E O4 D16"' a-
2780 PLAY "O2 B O3 E O4 D16 O2 B O3 E O4 D16
2790 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16"' dore
2800 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16
2810 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16
2820 PLAY "O2 A O3 E O4 C+16 O2 A O3 E O4 C+16
2830 LOCATE 11,40
2840 PRINT " "
2850 LOCATE 11,46
2860 PRINT CHR$(14)
2870 PLAY "O2 G+ O3 E B16 O2 G+ O3 E B16"' him
2880 PLAY "O2 G+ O3 E B16 P8
2890 PLAY "T210
2900 LOCATE 11,46
2910 PRINT " "
2920 LOCATE 14,1
2930 PRINT CHR$(14)
2940 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+ "' O
2950 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+
2960 LOCATE 14,1
2970 PRINT " "
2980 LOCATE 14,3
2990 PRINT CHR$(14)
3000 PLAY "O2 B O3 E G+ O4 D O2 B O3 E G+ O4 D"' come
3010 PLAY "O2 B O3 E G+ O4 D O2 B O3 E G+ O4 D
3020 LOCATE 14,3
3030 PRINT " "
3040 LOCATE 14,8
3050 PRINT CHR$(14)
3060 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+ "' let
3070 PLAY "O2 A O3 E A O4 C+ O2 A O3 E A O4 C+
3080 LOCATE 14,8
3090 PRINT " "
3100 LOCATE 14,12
3110 PRINT CHR$(14)
3120 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B"' us
3130 PLAY "O2 G+ B O3 E B O2 G+ B O3 E B
3140 LOCATE 14,12
3150 PRINT " "
3160 LOCATE 14,15
3170 PRINT CHR$(14)
3180 PLAY "O2 F+ B O3 E A O2 F+ B O3 D+ A"' a-
3190 PLAY "O2 F+ B O3 E A O2 F+ B O3 D+ A
3200 PLAY "O2 E B O3 E G+ O2 E B O3 E G+ "' dore
3210 PLAY "O2 E B O3 E G+ O2 E B O3 E G+
3220 PLAY "O2 D B O3 E G+ O2 D B O3 E G+
3230 PLAY "O2 D B O3 E G+ O2 D B O3 E G+
3240 LOCATE 14,15
3250 PRINT " "
3260 LOCATE 14,21
3270 PRINT CHR$(14)
3280 PLAY "O2 C+ A O3 E A O2 C+ A O3 E A"' him
3290 PLAY "O2 C+ A O3 E A O2 C+ A O3 E A
3300 PLAY "O2 D A O3 F+ O4 D O2 D A O3 F+ O4 D
3310 PLAY "O2 D A O3 F+ O4 D O2 D A O3 F+ O4 D
3320 PLAY "T200
3330 LOCATE 14,21
3340 PRINT " "
3350 LOCATE 14,26
3360 PRINT CHR$(14)
3370 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+ "' Christ
3380 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+
3390 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+
3400 PLAY "O2 E A O3 E O4 C+ O2 E A O3 E O4 C+
3410 PLAY "T190
3420 PLAY "O2 E G+ O3 E B O2 E G+ O3 E B
3430 PLAY "O2 E G+ O3 E B O2 E G+ O3 E B
3440 PLAY "O2 E G+ O3 E B O2 E G+ O3 E B
3450 PLAY "P8
3460 PLAY "T180
3470 LOCATE 14,26
3480 PRINT " "
3490 LOCATE 14,33
3500 PRINT CHR$(14)
3510 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A P16"' the
3520 PLAY "P8
3530 LOCATE 14,33
3540 PRINT " "
3550 LOCATE 14,37
3560 PRINT CHR$(14)
3570 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A"' Lord
3580 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A
3590 PLAY "T170
3600 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A
3610 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A
3620 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A
3630 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A
3640 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A
3650 PLAY "O1 A O2 A O3 C+ A O1 A O2 A O3 C+ A
3660 LOCATE 14,37
3670 PRINT " "
3680 CLS
3690 COLOR 4,2,6
3700 LOCATE 20,30
3710 PRINT " MERRY CHRISTMAS! "
3720 LOCATE 6,39
3730 PRINT " "
3740 LOCATE 7,38
3750 PRINT " "
3760 LOCATE 8,37
3770 PRINT " "
3780 LOCATE 9,36
3790 PRINT " "
3800 LOCATE 10,35
3810 PRINT " "
3820 LOCATE 11,34
3830 PRINT " "
3840 LOCATE 12,33
3850 PRINT " "
3860 LOCATE 13,32
3870 PRINT " "
3880 LOCATE 14,31
3890 PRINT " "
3900 LOCATE 15,30
3910 PRINT " "
3920 LOCATE 16,38
3930 PRINT " "
3940 LOCATE 1,1,0
Directory of PC-SIG Library Disk #0047
Volume in drive A has no label
Directory of A:\
DISRTN EXE 9728 6-06-82
CASTLE BAS 26230 5-31-82
CASTLE DOC 14976 5-31-82
NORMAL-Z BAS 7424 6-06-82
COMPRESS BAS 4608 6-06-82
MAILLIST BAS 7936 7-27-82
GDUMP1 BAS 640 7-17-82
GDUMP2 BAS 640 7-17-82
ELECTRIC BAS 6656 7-17-82
SORT-BLK BAS 9856 8-18-82
CHRONSET BAS 896 6-20-82
COMCHRON BAS 1664 9-06-82
FINPAK BAS 16565 9-05-82
KILLNULL BAS 384 6-05-82
PLOT BAS 1152 7-17-82
XMAS BAS 10496
CRC TXT 1310 11-09-84 10:04a
CRCK4 COM 1536 10-21-82 7:54p
18 file(s) 122697 bytes
33280 bytes free