TI- BASIC game source code

[Little Nero]

I'm new to programming so I was wondering if anyone had the source code for TI-99/4a games written in BASIC?

[+chue]

When I was a little younger, one of my favorite sources was "Compute!" magazine. They also published some books, one of which is here:

 

https://archive.org/download/COMPUTEs_First_Book_of_TI_Games_1983_COMPUTE_Publications/COMPUTEs_First_Book_of_TI_Games_1983_COMPUTE_Publications.pdf

 

The above link is for a PDF file, but I actually have it in book form. Be sure to post any questions you may have on it.

[Little Nero]

When I was a little younger, one of my favorite sources was "Compute!" magazine. They also published some books, one of which is here:

 

https://archive.org/download/COMPUTEs_First_Book_of_TI_Games_1983_COMPUTE_Publications/COMPUTEs_First_Book_of_TI_Games_1983_COMPUTE_Publications.pdf

 

The above link is for a PDF file, but I actually have it in book form. Be sure to post any questions you may have on it.

Thanks, this is way better than all the books I've seen so far.

[+TheBF]

I just woke up my old system from the 1980s and have been sending listings of games to my PC over RS232.

 

I actually typed the listing of Diamond Drop from Compute magazine.

 

Here is the listing fresh from a 34 year old floppy disk.

 

I think I did some changes to improve the responsiveness because that's what I did back then.

 

You will have to remove the "RUN DSK1.GAMES.LOAD" in line 620 and change it to STOP

10 REM *** diamond drop ***
20 REM * compute magazine *
30 REM *  september 1983  *
40 REM ********************
100 DIM KOLOR(6)
101 RIGHT=37 :: LEFT=-37 :: NOGO=0
110 RANDOMIZE
120 GOSUB 630
130 REM 108-DEFINE DIAMOND SPRITE CHAR,128-136 ARE THE PADDLES
140 CALL CHAR(108,"10387CFE7C38100000000000000000000000000000000000000000000000000000")
150 CALL CHAR(128,"FFFFFFFF0000FFFFFFFF0000FFFFFFFFFFFFFFFF0000FFFFFFFF0000FFFFFFFF")
160 CALL CHAR(132,"000000000000FFFFFFFF0000FFFFFFFF000000000000FFFFFFFF0000FFFFFFFF")
170 SCR=0 :: SK=0 :: CH=20 :: S=0 :: CALL CLEAR :: CALL SCREEN(15):: DISPLAY AT(4,:"D I A M O N D"
180 FOR ROW=3 TO 6
190 CALL HCHAR(ROW+2,6,32,20)
200 DISPLAY AT(ROW+3,6):"```  ```   ``  ```" :: DISPLAY AT(ROW+4,6):"h  h h  h h   h h  h"
210 DISPLAY AT(ROW+5,6):"p  p ppp  p  p ppp" :: DISPLAY AT(ROW+4,6):"x  x x  x x   x x  x"
220 DISPLAY AT(ROW+7,6):"h  h h  h h  h h" :: DISPLAY AT(ROW+8,6):"```  `  `  ``   `"
230 NEXT ROW
240 DISPLAY AT(18,4):"SKILL LEVEL (1,2) ?" :: ACCEPT AT(18,24)BEEP VALIDATE(DIGIT)SIZE(1):SK :: IF SK>2 THEN 240
250 DROP=5 :: IF SK=2 THEN DROP=15 :: REM ** change drop    rate to change difficulty *
260 DISPLAY AT(21,2):"DROP WITH ANGLE (Y/N) ?" :: ACCEPT AT(21,26)BEEP VALIDATE("YN")SIZE(1):ANG$
270 IF ANG$="N" THEN ANG=0 :: GOTO 290
280 ANG=1
290 CALL CLEAR :: SCR=SCR+1
300 DISPLAY AT(1,2):"CHANCES:";CH :: DISPLAY AT(1,15):"SCORE:";S
310 ROW=3 :: FOR I=96 TO 120 STEP 8
320 CALL HCHAR(ROW,3,I,28):: ROW=ROW+1 :: NEXT I
330 CALL HCHAR(24,1,30,32)
340 CALL MAGNIFY(3):: CALL SPRITE(#1,128,5,170,115)
350 KHAR=108 :: ROW=41 :: FOR J=6 TO 3 STEP -1
360 A$="" :: FOR I=3 TO 30 :: A$=A$&CHR$(I):: NEXT I :: N=28
370 IF N=0 THEN 530
380 R=INT(LEN(A$)*RND+1):: P$=SEG$(A$,R,1):: X=ASC(P$):: N=N-1 :: IF N=0 THEN 40
0
390 A$=SEG$(A$,1,R-1)&SEG$(A$,R+1,LEN(A$)-R)
400 B=INT(RND*61*ANG)-30*ANG
410 CALL HCHAR(J,X,32):: CALL SPRITE(#2,KHAR,KOLOR(J),ROW,8*(X-1)-2,DROP,B)
420 CALL KEY(3,K,ST):: IF K=68 THEN H=RIGHT ELSE H=0 :: IF K=83 THEN H=LEFT
440 IF H=NOG0 THEN CALL MOTION(#1,0,0)ELSE CALL MOTION(#1,0,H):: CALL SOUND(50,-1,12)
450 CALL COINC(ALL,C):: IF C THEN 510
460 CALL POSITION(#2,DROW,DCOL):: IF DROW<155 THEN 420
470 CALL POSITION(#1,PROW,PCOL):: IF (DCOL-PCOL<16)*(DCOL-PCOL>-8)THEN 510
480 CALL DELSPRITE(#2):: CALL MOTION(#1,0,0):: CH=CH-1 :: CALL SCREEN(11)
485 FOR F=1 TO 30 STEP 6
490 CALL SOUND(-100,110,F,110*F,F,150*F,F,-6,F/2):: CALL SCREEN(INT(F/2)+.5)
492 NEXT F 
494 CALL SCREEN(15):: IF CH=0 THEN GOTO 570
500 GOTO 520
510 CALL DELSPRITE(#2):: CALL MOTION(#1,0,0)
512 CALL SOUND(-9,4000,9,6479,9,5567,9,-5,0):: S=S+(60/J)*SK*SCR+(60/J)*SCR*INT(ABS(B)/15)
520 DISPLAY AT(1,2):"CHANCES:";CH :: DISPLAY AT(1,15):"SCORE:";S :: GOTO 370
530 K=K+4 :: ROW=ROW-8 :: M=128 :: IF J<6 THEN M=132
540 FOR F=0 TO 30 STEP -6 :: CALL SOUND(-300,150,F):: NEXT F
550 CALL SPRITE(#1,M,5,150,115,0,H)
560 NEXT J :: FOR G=600 TO 1400 STEP 100 :: CALL SOUND(100,G,1)
562 NEXT G
564 DROP=DROP+5 :: GOTO 290
570 CALL SCREEN(14):: IF S>HS THEN HS=S
580 CALL DELSPRITE(ALL):: CALL CLEAR :: DISPLAY AT(8,5):"YOUR SCORE: ";S :: DISPLAY AT(11,5):"HIGH SCORE: ";HS
590 DISPLAY AT(16,5):"PLAY AGAIN (Y/N)? "
592 IF S<HS THEN CALL SAY("UHOH NOT+SO+GOOD.WANT+TO+PLAY+AGAIN")ELSE CALL SAY("#NICE TRY#+#TRY AGAIN#")
594 ACCEPT AT(16,24)BEEP VALIDATE("NY")SIZE(1):REPLY$
600 IF REPLY$="N" THEN 620
610 GOTO 170
620 CALL SAY("O+K GOODBYE+FOR+NOW"):: CALL CLEAR :: RUN "DSK.GAMES.LOAD"
630 REM *****************
631 REM * define small  *           
632 REM * diamonds and  *
633 REM *    colors     *
634 REM *****************
640 FOR I=96 TO 120 STEP 8
650 CALL CHAR(I,"10387CFE7C381000"):: NEXT I
660 CALL COLOR(11,11,1)
670 CALL COLOR(9,3,1)
680 CALL COLOR(10,10,1)
690 CALL COLOR(12,14,1)
700 FOR J=3 TO 6 :: READ KOLOR(J):: NEXT J
710 DATA 3,10,11,14
720 RETURN
730 END

Edited September 9, 2018 by TheBF

[+TheBF]

Here is a strange game that I converted to TI-BASIC from a magazine.

I have never got to the end of the journey. Probably needs some tweaking with the random number windows to make it possible.

 

 

 

100 RANDOMIZE
110 REM********************
120 REM*       CAMEL      *
130 REM********************
140 REM creative computing version
150 REM translated to ti basic by: B.Fox
152 REM Jan 30, 1984
160 CALL CLEAR
170 CALL SCREEN(11)
180 PRINT TAB(10);"C A M E L": : : : : : :
190 PRINT TAB(6);"Converted by B.FOX": : :
200 PRINT TAB(4);"London Ontario Canada": : :
210 PRINT : : : : :
220 PRINT "WOULD YOU LIKE":"INSTRUCTIONS (Y/N)";
230 INPUT D$
240 IF D$="N" THEN 400
250 PRINT "A TRIBE OF KNOCKED KNEED":"PIGMIES WILL BE CHASING YOU.":
260 PRINT "YOU WILL BE ASKED FOR":"COMMANDS EVERY SO OFTEN.": : : :
270 PRINT "     *C O M M A N D S*": :
280 PRINT "#1 DRINK FROM YOUR CANTEEN"
290 PRINT "#2 AHEAD MODERATE SPEED"
300 PRINT "#3 AHEAD FULL SPEED"
310 PRINT "#4 STOP FOR THE NIGHT"
320 PRINT "#5 STATUS CHECK"
330 PRINT "#6 HOPE LIKE HELL,FOR HELP": :
340 INPUT "press enter to go on":CON$
350 CALL CLEAR
360 PRINT "YOU HAVE ONE LITRE OF WATER,WHICH WILL LAST YOU 6 DRINKS":
370 PRINT "YOU MAY RENEW YOUR WATER":"SUPPLY COMPLETELY AT AN":"OASIS.": :
380 PRINT TAB(9);"GOOD LUCK !";TAB(12);"AND":" GOOD CAMELLING.(sucker !)": :
390 INPUT "press enter to go on":CON$
400 CALL CLEAR
410 PRINT "YOU ARE IN THE MIDDLE OF THE DESERT AT AN OASIS": :
420 GOSUB 1760
430 IF C>199 THEN 1300
440 Z=Z-1
450 IF Z<>1 THEN 470
460 PRINT "   ***WARNING***": : :"   GET A DRINK !!!": :
470 IF Z<0 THEN 1690
480 P=P+1
490 RANDOMIZE
500 X2=INT(10*RND+2.5)
510 IF Q>0 THEN 1010
520 IF P<4 THEN 590
530 C1=C1+X2
540 IF C1<C THEN 580
550 PRINT "THE PIGMIES HAVE CAPTURED":"YOU.CAMEL AND PEOPLE SOUP IS"
560 PRINT "THEIR FAVOURITE DISH !!": :
570 GOTO 1650
580 PRINT : :"THE PIGMIES ARE ";C-C1:"MILES BEHIND YOU !": :
590 PRINT "YOU HAVE TRAVELED ";C;"MILES":"ALTOGETHER.": :
600 PRINT "WHAT IS YOUR COMMAND ": :;
610 INPUT Y
620 ON Y GOTO 900,690,760,840,870,630
630 T=INT(RND*10)
640 IF T<>1 THEN 1290
650 PRINT "HELP HAS FOUND YOU":"IN A STATE OF":"UNCONSCIOUSNESS": :
660 S=3
670 Z=4
680 GOTO 430
690 F=F+1
700 IF F=8 THEN 1280
710 GOSUB 950
720 X1=INT(10*RND)
730 C=C+X1
740 PRINT "YOUR CAMEL LIKES THIS PACE": :
750 GOTO 430
760 F=F+3
770 IF F>7 THEN 1280
780 GOSUB 950
790 X1=INT(20*RND)
800 C=C+X1
810 PRINT "YOUR CAMEL IS BURNING":"ACROSS THE DESERT SANDS": :
820 REM
830 GOTO 440
840 PRINT "YOUR CAMEL THANKS YOU !": :
850 F=0
860 GOTO 440
870 PRINT : :"YOUR CAMEL HAS ";7-F:"GOOD DAYS LEFT": :
880 PRINT "YOU HAVE ";S;"DRINKS":"LEFT IN YOUR CANTEEN": :
890 PRINT "YOU CAN GO";Z;"COMMANDS":"WITHOUT DRINKING": :
900 S=S-1
910 IF S<0 THEN 1290
920 PRINT "BETTER WATCH FOR AN OASIS !": : : :
930 Z=4
940 GOTO 600
950 A=INT(100*RND)
960 IF A>5 THEN 1210
970 PRINT "WILD BERBERS HIDDEN IN THE":"SAND HAVE CAPTUREED YOU": :
980 PRINT "LUCKILY THE LOCAL SHEIK":"HAS AGREED TO THEIRRANSOM...": : :
990 PRINT "DEMANDS....BUT....": : :"WATCH FOR THEM PIGMY":"          FELLERS !":
1000 PRINT "YOU HAVE A NEW CHOICE":"OF SUB-COMMANDS": :
1010 PRINT "   #7 ATTEMPT AN ESCAPE"
1020 PRINT "   #8 WAIT FOR PAYMENT": :
1030 PRINT "YOUR SUB-COMMAND";
1040 INPUT X
1050 IF X=8 THEN 1130
1060 X1=INT(20*RND)
1070 IF X1<5 THEN 1110
1080 PRINT "CONGRATULATIONS":"YOU SUCCESSFULLY ESCAPED !": : :
1090 Q=0
1100 GOTO 430
1110 PRINT "YOU WERE MORTALLY WOUNDED":"BY A PIG-STICKER WHILE ESCAPING": :
1120 GOTO 1510
1130 X1=INT(100*RND)
1140 REM        this rem is                 for nothing
1150 IF X1>24 THEN 1190
1160 PRINT "YOUR RANSOM HAS BEEN PAID":"AND YOU ARE FREE TO GO !": :
1170 Q=0
1180 GOTO 430
1190 PRINT "THE LOCAL SULTAN IS ":"COLLECTING...........": :"JUST WAIT.........."
1200 GOTO 430
1210 A=INT(10*RND)
1220 IF A>2 THEN 1330
1230 PRINT "YOU HAVE ARRIVED AT AN OASIS...":"YOUR CAMEL IS FILLING"
1240 PRINT "YOUR CANTEEN":"AND EATING FIGS": : :
1250 Z=4
1260 S=6
1270 RETURN
1280 PRINT "YOU DIRTY RAPSCALLION  !!!":" YOU RAN YOUR POOR CAMEL":"TO DEATH!!!!"
1290 GOTO 1510
1300 PRINT "YOU WIN !":"A PARTY IS BEING GIVEN":"IN YOUR HONOUR........": : :
1310 PRINT "...THE PIGMIES ARE PLANNING":"TO ATTEND....": : :
1320 GOTO 1650
1330 X1=INT(100*RND)
1340 IF X1>5 THEN 1440
1350 PRINT "YOU HAVE BEEN CAUGHT IN A":"SANDSTORM........":"GOOD LUCK !!!!": :
1360 X5=INT(10*RND)
1370 X6=INT(10*RND)
1380 IF X6<5 THEN 1410
1390 C=C+X5
1400 GOTO 1420
1410 C=C-X5
1420 PRINT "YOU NEW POSITION IS ";C;" MILES SO FAR": :
1430 RETURN
1440 X1=INT(100*RND)
1450 IF X1<5 THEN 1470
1460 RETURN
1470 C1=C1+1
1480 PRINT "YOUR CAMEL HURT HIS HUMP": :
1490 PRINT "LUCKILY THE PIGMIES WERE ":"FOOTWEARY": :
1500 RETURN
1510 U=INT(10*RND)
1520 PRINT "YOU BIT THE BIG ONE IN THE":"BLEEDIN'DESERT MATE !!!": :
1530 IF U>1 THEN 1560
1540 PRINT "THE NATIONAL CAMELS UNION":"IS NOT ATTENDING YOUR":" FUNERAL": :
1550 GOTO 1650
1560 IF U>3 THEN 1580
1570 GOTO 1650
1580 IF U>5 THEN 1610
1590 PRINT "THE LOCAL SHEIK NOW USES":"YOUR SKULL FOR A CHANGE PURSE": : :
1600 GOTO 1650
1610 IF U>7 THEN 1640
1620 PRINT "PEOPLE WITH LITTLE ":"INTELLIGENCE SHOULD STAY OUT":"THE DESERT": : :
1630 GOTO 1650
1640 PRINT "TURKEYS SHOULD FLY":"NOT RIDE CAMELS !": : :
1650 PRINT : : : :"WANT A NEW CAMEL?":"AND A NEW GAME ?": : :
1660 INPUT D$
1670 IF D$="Y" THEN 380
1680 GOTO 1710
1690 PRINT "YOU RAN OUT OF WATER": :"   SORRY CHUM": : :
1700 GOTO 1510
1710 FOR I=1 TO 2
1720 PRINT "*** OK! CHICKEN!***": : : : : : : : : : : : :
1730 NEXT I
1740 CALL CLEAR
1750 STOP
1760 Z=4
1770 S=6
1780 C=0
1790 C1=0
1800 Q=0
1810 F=0
1820 P=0
1830 RETURN
1840 END

 

 

[+OLD CS1]

In the vein of @TheBF, I spent a few years after COMPUTE! dropped the TI-99/4A converting programs from the magazine, usually the feature program. Recently (starting eight years ago, recently indeed) I started re-working them. I completed one of the reworks this year and it includes TIdBit, TI BASIC, and TI Extended BASIC sources. You can find Tiles here, or https://locu.li/tiles99 (look at the last post for the second release which includes more stuff.)

 

I am expecting to have several more done over the next year, but I have two projects to finish beforehand.

[+TheBF]

Here is an oldie that I found on a floppy disk.

 

ELIZA in TI BASIC.

 

It uses an external text file for the responses, so you will have make the second spoiler into a DV80 file.

 

It's not too speedy taking about 3 seconds to generate a response, but it's still fun.

 

BASIC code

 

 

100 CALL CLEAR
110 REM  ** E L I Z A ** 
120 REM  TI-BASIC version with external file data 
130 REM  by Brian Fox 
140 REM  CIRCA 1984 
150 OPTION BASE 1
160 DIM KEYWORD$(36),A$(7),B$(7),S(36),R(36),N(36),REPLY$(112)

170 PRINT TAB(9);"E L I Z A"::::::::
180 PRINT "    a psycho-analytical":
190 PRINT TAB(11);"program"::::::::
192 PRINT "Please standby while I"
194 PRINT "review your files..."

200 REM  Load Keywords
210 FOR I=1 TO 36
212   READ K$
214   KEYWORD$(I)=K$
216 NEXT I

220 REM  Load Conjugations
230 FOR X=1 TO 7
240   READ A$(X),B$(X)
250 NEXT X


260 REM Load reply file
270 N3=0
280 OPEN #1:"DSK2.ELIZAFILE",INPUT
290 IF EOF(1)THEN 330
300 N3=N3+1
310 INPUT #1:REPLY$(N3)
320 GOTO 290


330 N1=36
340 N2=14
350 RESTORE 1270
360 FOR X=1 TO 36
370 READ S(X),L
380 R(X)=S(X)
390 N(X)=S(X)+L-1
400 NEXT X
410 CALL CLEAR
420 DISPLAY "HI !":"I'M ELIZA.":"WHAT'S YOUR NAME ?"
430 INPUT NAME$
440 DISPLAY "HI ! ";NAME$:"WHAT'S YOUR PROBLEM ?"
450 REM  
460 REM  ***USER INPUTS HERE ***   
470 REM  
480 INPUT "":I$
490 REM    REMOVE ['] 
500 L=POS(I$,"'",1)
510 IF L=0 THEN 540
520 LET I$=SEG$(I$,1,L-1)&SEG$(I$,L+1,LEN(I$))
530 GOTO 500
540 IF POS(I$,"SHUT",1)THEN 1090
550 IF POS(I$,"ASS",1)THEN 1090
560 IF POS(I$,"FUC",1)THEN 1090
570 IF POS(I$,"SHIT",1)THEN 1090
580 IF P$<>I$ THEN 610
590 DISPLAY "PLEASE DON'T REPEAT":"YOUR-SELF ";NAME$
600 GOTO 450
610 REM  
620 REM  **Find Keyword** 
630 FOR K=1 TO 36
640 T=POS(I$,KEYWORD$(K),1)
650 IF T=0 THEN 670
660 IF SEG$(I$,T,LEN(KEYWORD$(K)))=KEYWORD$(K)THEN 720
670 NEXT K
680 REM    Key Not Found 
690 K=36
700 GOTO 960
710 REM  **FOUND A KEYWORD** 
720 REM  Take right part of string and conjugate,using, list to be swapped 
730 F$=K$
740 PA=1
750 PB=1
760 LET C$=" "&SEG$(I$,T+LEN(KEYWORD$(K)),LEN(I$))&" "
770 FOR X=1 TO 7
780 LET A=POS(C$,A$(X),PA)
790 LET B=POS(C$,B$(X),PB)
800 IF A+B=0 THEN 880
810 PA=A+LEN(A$(X))
820 IF A=0 THEN 840
830 LET C$=SEG$(C$,1,A-1)&B$(X)&SEG$(C$,PA,LEN(C$))
840 PB=B+LEN(B$(X))
850 IF B=0 THEN 880
860 LET C$=SEG$(C$,1,B-1)&A$(X)&SEG$(C$,PB,LEN(C$))
870 REM  
880 NEXT X
890 IF POS(C$," ",2)THEN 900 ELSE 910
900 C$=SEG$(C$,2,LEN(C$))
910 L=POS(C$,"!",1)
920 IF L=0 THEN 980
930 C$=SEG$(C$,1,L-1)&SEG$(C$,L+1,LEN(C$))
940 GOTO 910
950 REM  
960 REM
970 REM  
980 F$=REPLY$(R(K))
990 R(K)=R(K)+1
1000 IF R(K)<=N(K)THEN 1020
1010 R(K)=S(K)
1020 IF POS(F$,"*",LEN(F$))THEN 1060
1030 PRINT :F$::
1040 P$=I$
1050 GOTO 450
1060 PRINT :SEG$(F$,1,LEN(F$)-1);C$::
1070 P$=I$
1080 GOTO 450

1090 CALL CLEAR
1100 PRINT "I DON'T TOLERATE THAT KIND":"OF LANGUAGE ";NAME$;" !":"THIS SESSION IS OVER !"
1110 END
1120 REM   program data 
1130 REM
1140 REM   keywords  
1150 REM  
1160 DATA CAN YOU,CAN I,YOU ARE,YOURE,I DONT,I FEEL
1170 DATA WHY DONT YOU,WHY CANT I,ARE YOU,I CANT,I AM,IM
1180 DATA YOU,I WANT,WHAT,HOW,WHO,WHERE,WHEN,WHY
1190 DATA NAME,BECAUSE,SORRY,DREAM,HELLO,HI,MAYBE
1200 DATA NO,YOUR,ALWAYS,THINK,ALIKE,YES,FRIEND
1210 DATA COMPUTER,NOKEYFOUND
1220 REM
1230 REM  data for conjugations    
1240 DATA " ARE "," AM "," WERE "," WAS "," YOU "," I "," YOUR "," MY "
1250 DATA " IVE "," YOUVE "," IM "," YOURE "
1260 DATA " ME "," !YOU "
1270 DATA 1,3,4,2,6,4,6,4,10,4,14,3,17,3,20,2,22,3,25,3
1280 DATA 28,4,28,4,32,3,35,5,40,9,40,9,40,9,40,9,40,9,40,9
1290 DATA 49,2,51,4,55,4,59,4,63,1,63,1,64,5,69,5,74,2,76,4
1300 DATA 80,3,83,7,90,3,93,6,99,7,106,6
1310 REM  end of DATA 

 

 

 

 

DATA file with responses

 

 

DON'T YOU BELIEVE THAT I CAN*
PERHAPS YOU WOULD LIKE TO BE ABLE TO*
DO YOU WANT ME TO BE ABLE TO*
PERHAPS YOU DON'T WANT TO   *
DO YOU WANT TO BE ABLE TO   *
WHAT MAKES YOU THINK THAT I AM*
DOES IT PLEASE YOU TO BELIEVE THAT I AM*
PERHAPS YOU WOULD LIKE TO BE*
DO YOU SOMETIMES WISH YOU   WERE*
DON'T YOU REALLY*
WHY DON'T YOU*
DO YOU WISH TO BE ABLE TO   *
DOES THAT TROUBLE YOU ?
TELL ME MORE ABOUT SUCH FEELINGS
DO YOU OFTEN FEEL*
DO YOU ENJOY FEELING*
DO YOU REALLY BELIEVE I DON'T*
PERHAPS SOME DAY I WILL*
DO YOU WANT ME TO*
DO YOU THINK YOU SHOULD BE  ABLE TO*
WHY CAN'T YOU*
WHY ARE YOU INTERESTED IN   WHETHER OR NOT I AM*
WOULD YOU PREFER IF I WERE  NOT*
PERHAPS IN YOUR FANTASIES I AM*
HOW DO YOU KNOW YOU CAN'T*
HAVE YOU TRIED*
PERHAPS NOW YOU CAN*
DID YOU COME TO ME BECAUSE  YOU ARE*
HOW LONG HAVE YOU BEEN*
DO YOU BELIEVE IT NORMAL TO BE*
DO YOU ENJOY BEING*
LET'S DISCUSS YOU NOT  ME
YOU CAN'T THINK THAT I*
YOU'RE NOT REALLY TALKING   ABOUT ME ARE YOU ?
WHAT WOULD IT MEAN TO YOU IF YOU GOT*
WHY DO YOU WANT*
LET'S SUPPOSE YOU SOON GOT*
WHAT IF YOU NEVER GOT*
YOU KNOW    SOMETIMES I WANT*
WHY DO YOU ASK ?
DOES THAT QUESTION INTEREST YOU ?
WHAT ANSWER WOULD PLEASE YOUTHE MOST ?
WHAT DO YOU THINK ?
ARE SUCH QUESTIONS ON YOUR  MIND OFTEN ?
WHAT IS IT THAT YOU REALLY  WANT TO KNOW ?
HAVE YOU ASKED ANYONE ELSE ?
HAVE YOU ASKED SUCH         QUESTIONS BEFORE ?
WHAT ELSE COMES TO MIND     WHEN YOU ASK THAT ?
NAMES REALLY DON'T INTEREST ME.
I DON'T CARE ABOUT NAMES    PLEASE GO ON !
IS THAT THE REAL REASON ?
DON'T ANY OTHER REASONS COME TO MIND ?
DOES THAT REASON EXPLAIN    ANYTHING ELSE ?
WHAT OTHER REASONS MIGHT    THERE BE ?
PLEASE DON'T APOLOGIZE
APOLOGIES ARE NOT NECESSARY
WHAT FEELINGS DO YOU HAVE   WHEN YOU APOLOGIZE ?
DON'T BE SO DEFENSIVE !
WHAT DOES THAT DREAM SUGGEST TO YOU ?
DO YOU DREAM OFTEN ?
WHAT PERSONS APPEAR IN YOUR DREAMS ?
ARE YOU DISTURBED BY YOUR   DREAMS ?
HOW DO YOU DO               PLEASE STATE YOUR PROBLEM   IT'S YOUR NICKEL.
YOU DON'T SEEM QUITE CERTAIN
WHY THE UNCERTAIN TONE ?
CAN'T YOU BE MORE POSITIVE ?
YOU AREN'T SURE ?
DON'T YOU KNOW ?
WHY NOT ?
ARE YOU SAYING THAT JUST TO BE NEGATIVE
YOU ARE BEING A BIT NEGATIVE
ARE YOU SURE?
WHY NO !
WHY ARE YOU CONCERNED ABOUT MY*
WHAT ABOUT YOUR OWN*
CAN YOU THINK OF A SPECIFIC EXAMPLE ?
WHEN?
WHAT ARE YOU THINKING OF?
REALLY? ALWAYS?
DO YOU REALLY THINK SO ?
BUT YOU ARE NOT SURE YOU    *
DO YOU DOUBT YOU*
IN WHAT WAY ?
WHAT RESEMBLANCE DO YOU SEE?
WHAT DOES THE SIMILARITY    SUGGEST TO YOU?
WHAT OTHER CONNECTIONS DO   YOU SEE?
COULD THERE REALLY BE SOME  CONNECTION ?
HOW?
YOU SEEM QUITE POSITIVE.
ARE YOU SURE?
I SEE   BUT COULD YOU EXPANDON THAT A LITTLE ?
I UNDERSTAND BUT ISN'T THEREREALLY SOMETHING ELSE YOU   WOULD LIKE TO TELL ME
WHY DO YOU BRING UP THE     TOPIC OF FRIENDS?
DO YOUR FRIENDS WORRY YOU?
DO YOUR FRIENDS PICK ON YOU ?
ARE YOU SURE YOU HAVE ANY   FRIENDS?
DO YOU IMPOSE ON YOUR       FRIENDS?
PERHAPS YOUR LOVE FOR YOUR  FRIENDS WORRIES YOU.
DO COMPUTERS WORRY YOU?
ARE YOU TALKING ABOUT ME IN PARTICULAR ?
ARE YOU FRIGHTENED BY       MACHINES ?
WHY DO YOU MENTION          COMPUTERS ?
WHAT DO YOU THINK COMPUTERS HAVE TO DO WITH YOUR        PROBLEM ?
DON'T YOU THINK COMPUTERS   CAN HELP PEOPLE ?
WHAT IS IT ABOUT MACHINES   THAT WORRIES YOU ?
OK NOW LET'S SEE IF WE CAN  KEEP OUR CONVERSATION WITHINTHE REALM OF PSYCHOLOGY
WHAT DOES THAT SUGGEST TO   YOU ?
YOU ARE GOING TO HAVE TO BE HONEST WITH ME IF YOU WANT  HELP
I'M NOT SURE I UNDERSTAND   YOU FULLY.
COULD YOU SAY THAT IN       DIFFERENT TERMS FOR ME
CAN YOU ELABORATE ON THAT ?
THAT IS QUITE INTERESTING GO ON !

 

 

[HOME AUTOMATION]

It uses an external text file for the responses, so you will have make the second spoiler into a DV80 file.

 

Hmm, DV80 you say...

 

OK NOW LET'S SEE IF WE CAN KEEP OUR CONVERSATION WITHINTHE REALM OF PSYCHOLOGY... (89 CHARS!)

 

Vat shoold I doo Darling... :?

[+TheBF]

 

Hmm, DV80 you say...

 

OK NOW LET'S SEE IF WE CAN KEEP OUR CONVERSATION WITHINTHE REALM OF PSYCHOLOGY... (89 CHARS!)

 

Vat shoold I doo Darling... :?

 

Oops. So sorry dawling

 

The original was an internal format file. I thought that was awkward to pass around so I "fixed" it.

I am opening a new store called "Bugs Are Us"

 

So the simple answer is make the phrase shorter:

 

CAN WE KEEP OUR CONVERSATION WITHIN THE REALM OF PSYCHOLOGY?

 

How that's for customer service. :-)

[+TheBF]

Here is a simple game that I wrote in 1985. TUCHTYPE was never published until now.

The world may never be the same.

 

*EDIT* GOTO 620 in line 610 is clearly not needed. So much clearer on the big screen

 

 

 

 

100 !     TUCHTYPE
110 !
120 !a game to help to learn
130 !touch typing.
140 !author: B. Fox
150 !date:6.3.85
160 DIM CHAR$(100)
170 ON WARNING NEXT
180 !
190 CALL MAGNIFY(2)
200 CALL SCREEN(
210 CALL CLEAR
220 FOR J=0 TO 14 :: CALL COLOR(J,16,6):: NEXT J
230 DISPLAY AT(10,1)ERASE ALL:"one moment please..."
240 FOR J=1 TO 62
250 READ CHAR$(J)
260 NEXT J
290 !       instructions
300 !
310 DISPLAY AT(1,8)ERASE ALL:"TUCH-TYPING":RPT$("=",28)
320 DISPLAY AT(5,1):"    The computer will send  50 letters down the screen  one at a time."
330 DISPLAY AT(9,1):"Your job will be to press   the key as fast as you can."
340 DISPLAY AT(12,1):"After the letters have gone by, your score will be      calculated."
350 DISPLAY AT(17,1):"Select one of the following"
360 DISPLAY AT(19,1):"1) capitals only":"2) caps and small letters":"3) 2 plus punctuation"
370 ACCEPT AT(24,1)VALIDATE("123")SIZE(1):C
380 IF C=1 THEN DIF=25 ELSE IF C=2 THEN DIF=51 ELSE IF C=3 THEN DIF=61
390 !
400 !
410 DISPLAY AT(17,1):"* SKILL LEVEL *": :"1-ACE":"2-GOOD":"3-HUNT and PECK"
420 ACCEPT AT(24,1)VALIDATE("123")SIZE(1):SKIL_LEVEL
430 SKIL_LEVEL=SKIL_LEVEL*25
440 !
450 !=====================
460 !    let's play
470 DISPLAY AT(24,1)ERASE ALL:"#","MISSES:"
480 TIME,MISSES=0
490 !
500 RANDOMIZE ! ALL NUMBERS
510 FOR LETTER=1 TO 50 :: DISPLAY AT(24,2)SIZE(3):LETTER :: DISPLAY AT(24,23):MISSES
520 ROW=1
530 COL=RND*200+20
540 CHR=ASC(CHAR$(RND*DIF+1))
550 CALL SPRITE(#1,CHR,16,ROW,COL,15,0)
560 !
570 !    get response loop
580 FOR J=1 TO SKIL_LEVEL
590 CALL KEY(0,K,S)
600 IF S=0 THEN 620
610 IF K=CHR THEN 640 ELSE CALL SOUND(-10,110,0):: MISSES=MISSES+1 :: GOTO 620
620 NEXT J
630 MISSES=MISSES+1
640 TIME=TIME+J :: CALL SOUND(10,1000,0)
650 CALL DELSPRITE(#1)
660 !
670 NEXT LETTER
680 !
690 !
700 !=====================
710 !    calulate score
720 !
730 AVRESPONSE=MIN(SKIL_LEVEL,TIME/(50-MISSES))
740 TOTAL_ERRORS=MISSES
750 PER_CENT=100-TOTAL_ERRORS/50*100
760 !
770 CALL CLEAR
780 DISPLAY AT(1,4):"LET'S SEE HOW YOU DID !":RPT$("=",28): : : :
790 DISPLAY AT(4,1):"Max allowed time =";SKIL_LEVEL
800 DISPLAY AT(6,1):"Average response time=" :: DISPLAY AT(6,23):USING "##.##":AVRESPONSE
810 DISPLAY AT(8,1):"TOTAL MISTAKES=";TOTAL_ERRORS
820 DISPLAY AT(10,1):"YOUR ACCURACY=";PER_CENT;"%"
830 IF PER_CENT=100 THEN GOSUB 990 :: GO TO 880
840 IF PER_CENT<50 THEN GOSUB 1090 :: GO TO 880
850 IF PER_CENT<70 THEN GOSUB 1070 :: GO TO 880
860 IF PER_CENT<90 THEN GOSUB 1050 :: GO TO 880
870 IF PER_CENT<100 THEN GOSUB 1030
880 DISPLAY AT(20,1):"PLAY AGAIN? "
890 ACCEPT AT(20,13)VALIDATE("YN")SIZE(1):Z$
900 IF Z$="N" THEN CALL CLEAR :: STOP ELSE 310
910 END
920 !     DATA_SEGMENT
930 !
940 DATA A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
950 DATA a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z
960 DATA 1,2,3,4,5,6,7,8,9,0
970 DATA !,@,#,$,%,^,&,*,(,),<,>,/,-
980 END DATA_SEGMENT
990 ! PERFECT SCORE
1000 FOR J=1 TO 10 :: CALL SOUND(-300,110*J,10-J):: NEXT J :: CALL SOUND(3000,139,0,165,0,220,0)
1010 FOR J=1 TO 10 :: DISPLAY AT(16,1):"" :: DISPLAY AT(16,1):"WOW! A PERFECT SCORE !!!" :: NEXT J
1020 RETURN
1030 DISPLAY AT(16,1):"HEY THAT'S PRETTY GOOD !"
1040 RETURN
1050 DISPLAY AT(16,1):"YOU NEED A BIT OF PRACTICE"
1060 RETURN
1070 DISPLAY AT(16,1):"DON'T CALL US WE'LL CALL YOU"
1080 RETURN
1090 DISPLAY AT(16,1):"WOW! THAT'S PRETTY ROTTEN !"
1100 RETURN
1110 END SUBROUTINES

 

 

Edited September 12, 2018 by TheBF

[HOME AUTOMATION]

 

Oops. So sorry dawling

 

The original was an internal format file. I thought that was awkward to pass around so I "fixed" it.

I am opening a new store called "Bugs Are Us"

 

So the simple answer is make the phrase shorter:

 

CAN WE KEEP OUR CONVERSATION WITHIN THE REALM OF PSYCHOLOGY?

 

How that's for customer service. :-)

Just curious,

 

I figured as much...

 

I'm happy I got what I paid for though!

 

I've been trying to explain the ELIZA program to my mother

for some time now but all I keep getting are basic responses.

 

P.S. You look marvelous!!! (...your work)

[+TheBF]

SMPTE Color Bars (well Almost)

 

(Used to work in TV Engineering)

 

 

 

100 REM  SMPTE Style Color Bars
110 REM  Brian Fox 2018
120 CALL CLEAR
130 CALL SCREEN(2)
140 CALL COLOR(8,15,1)
150 CALL COLOR(9,11,1)
160 CALL COLOR(10,8,1)
170 CALL COLOR(11,13,1)
180 CALL COLOR(12,14,1)
190 CALL COLOR(13,10,1)
200 CALL COLOR(14,5,1)
210 CALL COLOR(15,2,1)
220 CALL COLOR(16,16,1)

230 GOSUB 510

240 REM  color bars
250 CALL VCHAR(1,3,88,96)
260 CALL VCHAR(1,7,96,96)
270 CALL VCHAR(1,11,104,96)
280 CALL VCHAR(1,15,112,96)
290 CALL VCHAR(1,19,120,96)
300 CALL VCHAR(1,23,128,96)
310 CALL VCHAR(1,27,136,96)

320 REM  BLACK BAR
330 CALL HCHAR(19,1,144,224)

340 REM  WHITE BOX
350 CALL HCHAR(19,8,152,6)
360 CALL HCHAR(20,8,152,6)
370 CALL HCHAR(21,8,152,6)
380 CALL HCHAR(22,8,152,6)
390 CALL HCHAR(23,8,152,6)
400 CALL HCHAR(24,8,152,6)

410 REM  SMPTE Complementary boxes 
420 CALL HCHAR(18,3,136,4)
430 CALL HCHAR(18,7,144,4)
440 CALL HCHAR(18,11,120,4)
450 CALL HCHAR(18,15,144,4)
460 CALL HCHAR(18,19,104,4)
470 CALL HCHAR(18,23,144,4)
480 CALL HCHAR(18,27,88,4)
490 CALL SOUND(3000,400,12)
500 GOTO 490

510 SQUARE$="FFFFFFFFFFFFFFFF"
520 CALL CHAR(88,SQUARE$)
530 CALL CHAR(96,SQUARE$)
540 CALL CHAR(104,SQUARE$)
550 CALL CHAR(112,SQUARE$)
560 CALL CHAR(120,SQUARE$)
570 CALL CHAR(128,SQUARE$)
580 CALL CHAR(136,SQUARE$)
590 CALL CHAR(144,SQUARE$)
600 CALL CHAR(152,SQUARE$)
610 RETURN

 

 

 

 

[+TheBF]

Another Gem from an Ancient Floppy disk

 

Space Junket was typed from a magazine by me and my (then) teenage sister in-law. It's in the "Asteroids" tradition.

 

I changed the original line numbers in this listing to try and see the code more clearly.

 

I changed for/next delays for a CALL SOUND sub-routine.

 

I also add a COINC(ALL,HIT) line to avoid scanning all the sprites all the time. It seemed to speed up the keyboard response.

 

It's a beautiful example of spaghetti in the tradition of the era. I know it could greatly improved.

100 !**********************
110 !    SPACE JUNKET
120 !**********************
130 !    by Tarik Isani
140 !    99'er version
150 !    keyed by B.fox              & K.Tielemans
160 !    Feb-26-1984        ***************************
170 CALL CLEAR :: CALL SCREEN(2):: RANDOMIZE
180 CALL MAGNIFY(3):: P,R=1 :: S=3
190 DIM M(8,2),DM(9)

200 DATA -20,0,-20,20,0,20,20,20,20,0,20,-20,0,-20,-20,-20
210 FOR I=1 TO 8
212    FOR J=1 TO 2
213      READ M(I,J)
215    NEXT J
216 NEXT I

220 FOR SET=1 TO 12
222    CALL COLOR(SET,16,2)
224 NEXT SET

230 DISPLAY AT(1,5):"** SPACE JUNKET **": :"           BY":"       TARIK ISANI"
240 DISPLAY AT(6,1):"MANEUVER YOUR SPACECRAFT,":"CLEARING YOUR FLIGHT OF"
250 DISPLAY AT(8,1):"METEOROIDS,WITHOUT CRASHING":"INTO THEM"
260 DISPLAY AT(11,1):"ROTATE YOUR SHIP BY PRESSING'S'OR'D',OR MOVE THE ":"JOYSTICK LEFT AND RIGHT"
270 DISPLAY AT(15,1):"ACTIVATE YOUR ENGINES BY":"PRESSING'E',OR MOVING THE   JOYSTICK FORWARD"
280 DISPLAY AT(19,1):"TO LAUNCH YOUR MINES PRESS  'Q',OR PRESS THE FIRE BUTTON ON THE JOYSTICK"
290 DISPLAY AT(24,1):"(PRESS ANY KEY TO BEGIN)"

300 CALL KEY(0,S1,S2)
301 IF S2=0 THEN 300

310 DISPLAY AT(12,4)ERASE ALL:"METHOD OF INPUT:": :"     1.JOYSTICK": :"     2.ARROW KEYS"
320 CALL KEY(0,Z1,Z2)
322 IF (Z1<49) OR (Z1>50) THEN 320

330 CALL CLEAR
340 CALL COLOR(1,2,1,3,16,1,4,16,1,5,2,16,6,2,16,7,2,14,8,9,1)
350 CALL CHAR(48,"007E42424242427E"):: CALL CHAR(49,"0008080808080808")
360 CALL CHAR(50,"007E02027E40407E"):: CALL CHAR(51,"007E02027E02027E")
370 CALL CHAR(52,"004242427E020202"):: CALL CHAR(53,"007E40407E02027E")
380 CALL CHAR(54,"007E40407E42427E"):: CALL CHAR(55,"007E020202020202")
390 CALL CHAR(56,"007E42427E42427E"):: CALL CHAR(57,"007E42427E02027E")
400 CALL CHAR(74,"00FFFFFFFFFFFFFFFFFFFF")
410 CALL CHAR(80,"003C40405C444438003844447C44444400446C5454444444007C40407840407C")
420 CALL CHAR(84,"0000000000000000007C44444444447C00444444282810100078444478504844")
430 GO$=CHR$(80)&CHR$(81)&CHR$(82)&CHR$(83)&CHR$(84)&CHR$(85)&CHR$(86)&CHR$(83)&CHR$(87)
440 CALL CHAR(88,"181818183C3C7E7E")
450 CALL CHAR(92,"F8F8C0C0C0000303030300C0C0C0F8F81F1F03030300C0C0C0C0000303031F1F")
460 CALL CHAR(96,"0045104022000881002400411002200010004800842002008924400802884")
470 CALL CHAR(100,"80400822080114050B01220842204080011004580008C01040308024008C0201")
480 CALL CHAR(104,"00000303030303070707071F1F1F1F000000C0C0C0C0C0E0E0E0E0F8F8F8F8")
490 CALL CHAR(108,"000000000103277FFF7F37170F07030100081C3E7CF8F0E0F0E0C08080C08")
500 CALL CHAR(112,"00000038383F3F3F3F3F3F3838000000000000000080FCFCFCFC8")
510 CALL CHAR(116,"0103070F1F3F7FFF7F270301000000000080C08080C0E0F0E0F0FA7C3E1C08")
520 CALL CHAR(120,"00001F1F1F07070707030303030300000000F8F8F8E0E0E0E0C0C0C0C0C")
530 CALL CHAR(124,"08000103010103070F070F1F3E7C38100080C0E0F0F8FCFEFFFEE4C08")
540 CALL CHAR(128,"0000000000013F3F3F3F0100000000000000001C1CFCFCFCFCFCFC1C1C")
550 CALL CHAR(132,"0010387C3E1F0F070F070301010301000000000080C034FEFFFEFCF8F0E0C08")
560 CALL CHAR(136,"061D2E3D6E75A6FCCDAF793B3D161F07A0D85CF476AB5FCA6B2D2AF62E4AB08")
570 CALL CHAR(140,"0000000002040A01010A04020000000000000004020508080502040")

580 CALL SOUND(100,900,0)
582 CALL SOUND(100,700,0)
584 CALL SOUND(100,800,0)
586 CALL SOUND(100,1000,0)

590 CALL HCHAR(1,3,48,6)
591 DISPLAY AT(1,10):"HIGH:"&RPT$("0",6-LEN(STR$(HS)))&STR$(HS):: CALL HCHAR(2,12,74,4)
600 CALL HCHAR(1,25,88,S-1)

610 FOR I=2 TO 9 
611    CALL SPRITE(#I,136,RND*12+3,1,RND*255+1,RND*9+1,RND*2+1)
612 NEXT I

620 FOR I=2 TO 9 
621   DM(I)=0
622 NEXT I

630 DISPLAY AT(1,23):RPT$(CHR$(88),S-1)
632 CALL SPRITE(#1,104,7,95,125,0,0)
634 CALL SOUND(-50,900,0)
636 X,Y=0
640 CALL PATTERN(#1,92)
650 CALL COLOR(#1,9):: CALL KEY(1,S1,S2):: CALL COLOR(#1,5)
660 IF S1<>18 THEN 650 ELSE CALL SPRITE(#1,104,11,95,125,0,0)
670 CALL COLOR(#1,11)

680 IF Z1=49 THEN CALL JOYST(1,A,B):: GOTO 710
690 CALL KEY(1,S1,S2)
700 IF S1=2 THEN A=-4 :: B=0 ELSE IF S1=3 THEN A=4 :: B=0 ELSE IF S1=5 THEN A=0:: B=4 ELSE A,B=0
710 IF X<>0 OR Y<>0 THEN V=30-MAX(ABS(X),ABS(Y)):: CALL SOUND(-1000,-6,V,110,V,110,V)
720 IF A<>0 OR B<>4 THEN 750 ELSE X1=X+M(P,1)/10 :: X=MIN(ABS(X1),20)*SGN(X1)
730 Y1=Y+M(P,2)/10 :: Y=MIN(ABS(Y1),20)*SGN(Y1)
740 CALL MOTION(#1,X1,Y1):: GOTO 760
750 P=P+SGN(A):: IF P=0 THEN P=8 ELSE IF P=9 THEN P=1

760 CALL PATTERN(#1,(4*P)+100)
761 CALL COINC(ALL,HIT):: IF HIT=0 THEN 771
762 FOR J=2 TO 9
763   IF DM(J)=1 THEN 770
764   CALL COINC(#J,#1,16,H):: IF H THEN 900
770 NEXT J
771 CALL KEY(1,C,D)
772 IF C<>18 THEN 680

780 CALL POSITION(#1,PO1,PO2)
790 CALL SPRITE(#10,140,16,PO1,PO2,M(P,1),M(P,2))
791 CALL COLOR(#1,
792 CALL PATTERN(#1,92)
800 CALL SOUND(-500,110,3,440,0)

810 FOR J=2 TO 9
812    IF DM(J)=1 THEN 820
814    CALL COINC(#J,#10,16,H)
816    IF H THEN 860
820 NEXT J

822 VP=VP+1 :: IF VP=3 THEN 840
824 GOTO 810

830 REM      Delete Missile ***************************
840 CALL DELSPRITE(#10):: VP=0 :: GOTO 670

850 REM      Asteroid Hit   ***************************
860 CALL DELSPRITE(#10)
870 CALL PATTERN(#J,96):: CALL SOUND(-500,6000,15,5345,20,999,30,-8,0):: CALL DELSPRITE(#J):: DM(J)=1 :: SC=SC+40+R*5

880 VP=0 :: DISPLAY AT(1,1)SIZE(6):RPT$("O",6-LEN(STR$(SC)))&STR$(SC):: HI=HI+1
881 IF HI=8 THEN 1080 ELSE 670

890 REM *** CRASH ***
900 CALL COLOR(#1,9):: CALL PATTERN(#1,100,#J,96):: DM(J)=1
910 CALL SCREEN(12)
920 CALL SCREEN(2)
921 FOR I=0 TO 30 STEP 3 
922   CALL SOUND(-500,110+I,I,115+I,I,800,30,-8,I/1.5)
923   CALL SOUND(-500,111,I,-5,I)
924 NEXT I

930 FOR I=1 TO 3 
931   CALL SCREEN(12):: CALL SCREEN(2)
932 NEXT I 
933 LET S=S-1

940 DLY=100
941 GOSUB 2000

942 CALL DELSPRITE(#J,#10)

943 DLY=100
944 GOSUB 2000

950 LET HI=HI+1 :: IF HI=8 THEN 1080
960 IF S<>0 THEN P=1 :: GOTO 630
970 CALL DELSPRITE(#1)

971 FOR I=30 TO 0 STEP -1
972   CALL SOUND(-200,-5,I)
973 NEXT I

980 FOR I=1 TO 3
981   CALL SCREEN(12):: CALL SOUND(-200,-5,0):: CALL SCREEN(2):: CALL SOUND(-200,-6,0)
982 NEXT I

990 CALL SOUND(-400,-7,0)
1000 IF SC<=HS THEN 1040 ELSE HS=SC

1010 DLY=200
1011 GOSUB 2000

1012 DISPLAY AT(1,15)SIZE(6):RPT$("O",6-LEN(STR$(HS)))&STR$(HS)

1020 FOR I=1 TO 10
1021   CALL COLOR(5,2,7,6,2,7):: CALL SOUND(-200,900,0)
1030   CALL COLOR(5,2,16,6,2,16):: CALL SOUND(-200,800,0)
1031 NEXT I

1040 X,Y,SC,HI=0 :: R,P=1 :: S=3 :: DISPLAY AT(12,10):GO$
1050 CALL COLOR(7,14,2):: CALL KEY(1,A,B):: CALL COLOR(7,2,14):: IF B=0 THEN 1050 ELSE CALL HCHAR(12,1,32,32)
1060 GOTO 580

1070 REM ALL DESTROYED
1080 CALL DELSPRITE(ALL)
1090 CALL SOUND(200,9999,30):: CALL SOUND(20,1100,0):: CALL SOUND(60,9999,30)::CALL SOUND(300,1100,0)
1100 P=1 :: R=MIN(R+1,4):: HI=0
1101 IF S=0 THEN 970 ELSE 610
1110 REM

1999 REM delay
2000 CALL SOUND(DLY, 20000,30)
2010 RETURN
9999 END SPACEJUNKET

[+TheBF]

Pulled another classic off a diskette recently.  MELTDOWN by Steve Langguth

From Home Computer Magazine   

It's weird to think about how long ago it was AND that I typed this listing from a book.

 

Spoiler

100 REM ************
110 REM * MELTDOWN *
120 REM ************
130 REM
140 REM BY STEVE LANGGUTH
150 REM HOME COMPUTOR MAGAZINE
160 REM VERSION 4.1.1
170 REM TI EXTENDED BASIC
180 REM
190 REM**TITLE SCREEN**
200 REM
210 CALL CLEAR :: DISPLAY AT(11,11):"MELTDOWN"
220 REM *DEFINE CHARACTERS*
230 CALL CHAR(43,"0000FF8181FF0000",37,"007E7E42427E7E00")
240 CALL CHAR(96,"03060603013F3435343703030303030FC06060C080FC2CAC2CE0606060780000")
250 CALL CHAR(100,"03060603013F343534070606061E0000C06060C080FC2CAC2CECC0C0C0C0C0F0")
260 CALL CHAR(104,"00000000000038EE030000000000000000000000000038EE8300000000000000")
270 CALL CHAR(108,"0103060C193366CCCC6633190C06030180C0603098CC66333366CC983060C080")
280 CALL CHAR(132,"66",116,"66",124,"66")
290 CALL CHAR(112,"001F2040404E5B51515B4E4040201F0000F80402020202324A12227A0204F800")
300 CALL CHAR(120,"0000103B12021E10101E02123B100000000008DC4840780808784048DC080000")
310 CALL CHAR(140,"C1E171381C0E07E3E3070E1C3871E1C183878E1C3870E0C7C7E070381C8E8783")
320 CALL CHAR(128,"012110080204011BC30904112140000000000284882090C3D880204010088480")
330 CALL CHAR(136,"00001212123F7FD5D57F3F12121200000000484848FCFEABABFEFC4848480000")
340 REM **INITIALIZATION**
350 RESTORE :: OPTION BASE 1 :: DIM ROW(12):: DIM COL(12):: DIM VEL(12):: DIM MP(12):: DIM PPR(6):: DIM PPC(6)
360 FOR X=1 TO 12 :: READ ROW(X),COL(X),VEL(X):: NEXT X
370 FOR X=1 TO 12 :: READ MP(X):: NEXT X
380 FOR X=1 TO 6 :: READ PPR(X),PPC(X):: NEXT X
390 REM **KEYS OR JOYST**
400 CALL CLEAR :: DISPLAY AT(7,6):"DO YOU WISH TO USE" :: DISPLAY AT(9,10):"1 JOYSTICK "
410 DISPLAY AT(11,3):"-NOTE-RELEASE ALPHA LOCK-"
420 DISPLAY AT(14,10):"2 KEYBOARD ?" :: DISPLAY AT(16,6):"PRESS 1 OR 2"
430 CALL KEY(0,K,S):: IF K<>49 AND K<>50 THEN 430
440 IF K=49 THEN K1=1 ELSE K1=0
450 REM **DRAW PLAY FIELD**
460 CALL COLOR(1,2,2,2,2,2,11,2,2,12,2,2,13,2,2)
470 CALL CLEAR :: CALL SCREEN(2):: CALL MAGNIFY(3)
480 FOR T=1 TO 4 :: READ R1,C1 :: CALL HCHAR(R1,C1,37,14):: NEXT T
490 FOR T=1 TO 10 :: READ R2,C2 :: CALL HCHAR(R2,C2,43,14):: NEXT T
500 FOR T=1 TO 4 :: READ R3,C3 :: CALL VCHAR(R3,C3,37,2):: NEXT T
510 FOR T=1 TO 6 :: READ R4,C4,CH4 :: CALL HCHAR(R4,C4,CH4,15):: NEXT T
520 FOR T=1 TO 6 :: READ R5,C5 :: CALL SPRITE(#(T+5),140,2,R5,C5):: NEXT T
530 CALL COLOR(1,5,2,2,5,2)
540 FOR X=3 TO 8 :: CALL COLOR(X,16,2):: NEXT X
550 ARMOR=5 :: OXYGEN=100 :: SCORE=0 :: LEVEL=1 :: PN=0 :: OF=0 :: AM=0
560 DISPLAY AT(23,19)SIZE(5):"SCORE" :: DISPLAY AT(22,1)SIZE(6):"OXYGEN"
570 DISPLAY AT(24,2)SIZE(5):"ARMOR"
580 DISPLAY AT(22,7)SIZE(4):OXYGEN :: DISPLAY AT(24,8)SIZE(3):ARMOR
590 DISPLAY AT(12,14)SIZE(2):LEVEL :: CALL SOUND(100,(330*LEVEL),2,(392*LEVEL),2,(523*LEVEL),2)
600 GOSUB 1950
610 CALL SOUND(25,262,30):: CALL SOUND(500,(330*LEVEL),2,(392*LEVEL),2,(523*LEVEL),2)
620 FOR T=1 TO 250 :: NEXT T
630 DISPLAY AT(12,14)SIZE(2):"  "
640 REM **CREATE HERO**
650 CALL SPRITE(#1,96,3,165,121):: S=0 :: SH=0
660 PN=PN+1 :: IF PN>(15*LEVEL)THEN 1620
670 REM **CREATE OXYGEN**
680 IF OF=1 THEN 730
690 RANDOMIZE :: Q=INT(RND*3)+1 :: P=INT(RND*6)+1
700 IF Q<>2 THEN 730
710 CALL SPRITE(#4,112,12,PPR(P),PPC(P)):: OF=1 :: CALL SOUND(50,3000,3,4000,5)
720 REM **GAMMA RAYS**
730 RANDOMIZE :: X=INT(RND*2)+1 :: IF X<>2 THEN 910
740 RANDOMIZE :: Y=INT(RND*3)+1 :: ON Y GOTO 750,800,850
750 CALL COLOR(#6,16):: CALL SOUND(200,2500,2):: CALL COLOR(#7,16):: CALL SOUND(200,2600,2)
760 GOSUB 1770
770 CALL COLOR(11,16,2):: CALL SOUND(100,1000,2,1200,4):: CALL POSITION(#1,DR,DC)
780 IF (DR<20)+(DR>30)=0 OR(DR<92)+(DR>102)=0 THEN CALL COLOR(11,2,2):: CALL COLOR(#6,2,#7,2):: GOTO 1340
790 CALL COLOR(11,2,2):: CALL COLOR(#6,2,#7,2):: GOTO 910
800 CALL COLOR(#8,16):: CALL SOUND(200,2700,2):: CALL COLOR(#9,16):: CALL SOUND(200,2800,2)
810 GOSUB 1770
820 CALL COLOR(12,16,2):: CALL SOUND(100,1000,2,1200,4):: CALL POSITION(#1,DR,DC)
830 IF (DR<44)+(DR>54)=0 OR(DR<116)+(DR>126)=0 THEN CALL COLOR(12,2,2):: CALL COLOR(#8,2,#9,2):: GOTO 1340
840 CALL COLOR(12,2,2):: CALL COLOR(#8,2,#9,2):: GOTO 910
850 CALL COLOR(#10,16):: CALL SOUND(200,2900,2):: CALL COLOR(#11,16):: CALL SOUND(200,3000,2)
860 GOSUB 1770
870 CALL COLOR(13,16,2):: CALL SOUND(100,1000,2,1200,4):: CALL POSITION(#1,DR,DC)
880 IF (DR<68)+(DR>78)=0 OR(DR<140)+(DR>150)=0 THEN CALL COLOR(13,2,2):: CALL COLOR(#10,2,#11,2):: GOTO 1340
890 CALL COLOR(13,2,2):: CALL COLOR(#10,2,#11,2):: GOTO 910
900 REM**ANTIMATTER**
910 IF LEVEL<2 THEN 970
920 RANDOMIZE :: X=INT(RND*2)+1 :: Y=INT(RND*(8-LEVEL))+1 :: Z=INT(RND*6)+1
930 IF AM<>1 THEN 950
940 IF X=2 THEN CALL DELSPRITE(#5):: CALL SOUND(50,3333,2,4444,3):: AM=0 :: GOTO 970
950 IF Y=1 THEN CALL SPRITE(#5,120,6,PPR(Z),PPC(Z)):: AM=1 :: CALL SOUND(50,2222,2,3333,3)
960 REM **PARTICAL CHOOSE**
970 RANDOMIZE :: X=INT(RND*(LEVEL*2))+1 :: ON X GOTO 980,980,980,990,980,990,990,990,990
980 CN=108 :: GOTO 1010
990 CN=136 :: GOTO 1010
1000 REM **MAIN GAME LOOP**
1010 GOSUB 1770
1020 RANDOMIZE :: X=INT(RND*12)+1 :: Y=INT(RND*13)+3 :: CALL SPRITE(#3,CN,Y,ROW(X),COL(X),0,VEL(X)*(5+LEVEL))
1030 IF CN=108 THEN 1040 ELSE 1050
1040 FOR A=0 TO 30 STEP 15 :: CALL SOUND(-99,250+Y*10,A,1512+Y*10,A):: NEXT A :: GOTO 1060
1050 FOR T=1 TO 3 :: CALL SOUND(25,5000,2,5555,3,6000,2):: NEXT T
1060 IF SH<>0 THEN CALL COINC(#2,#3,15+LEVEL,HIT1):: IF HIT1=-1 THEN 1250
1070 GOSUB 1850
1080 IF OF<>1 THEN 1090 ELSE CALL COINC(#1,#4,15,HIT3):: IF HIT3=-1 THEN 1410
1090 IF AM<>1 THEN 1100 ELSE CALL COINC(#1,#5,10,HIT5):: IF HIT5=-1 THEN AM=0 :: GOTO 1440
1100 GOSUB 1770
1110 CALL COINC(#1,#3,15,HIT2):: IF HIT2=-1 THEN 1340
1120 IF SH<>0 THEN CALL COINC(#2,#3,15+LEVEL,HIT1):: IF HIT1=-1 THEN 1250
1130 GOSUB 1850
1140 CALL POSITION(#2,DR2,DC2):: IF DC2>40 AND DC2<210 THEN 1160
1150 CALL DELSPRITE(#2):: SH=0
1160 GOSUB 1770
1170 CALL POSITION(#3,DR3,DC3):: IF DC3>25 AND DC3<225 THEN 1220
1180 CALL DELSPRITE(#3):: IF SCORE<5 THEN SCORE=0 ELSE SCORE=SCORE-5
1190 OXYGEN=OXYGEN-1 :: DISPLAY AT(23,24):SCORE
1200 DISPLAY AT(22,7)SIZE(4):OXYGEN :: RH=0
1210 IF OXYGEN<1 THEN 1440 ELSE 660
1220 OXYGEN=OXYGEN-1 :: DISPLAY AT(22,7)SIZE(4):OXYGEN :: IF OXYGEN<1 THEN 1440
1230 CALL SOUND(40-(LEVEL*3),1000+(LEVEL*200),2,500+(LEVEL*150),2)
1240 CALL SOUND(40-(LEVEL*3),500+(LEVEL*200),2,250+(LEVEL*150),2):: GOTO 1060
1250 IF CN=108 THEN 1280
1260 IF RH=1 THEN 1280 ELSE CALL DELSPRITE(#2):: RH=1 :: SCORE=SCORE+10 :: CALL COLOR(#3,16)
1270 CALL MOTION(#3,0,VEL(X)*(7+LEVEL)):: GOTO 1060
1280 REM **DESTROY PARTICAL*
1290 CALL DELSPRITE(#2):: CALL MOTION(#3,0,0,#1,0,0):: RH=0
1300 FOR T=1 TO 5 :: CALL COLOR(#3,2):: CALL SOUND(-25,1111,2)
1310 CALL COLOR(#3,10):: CALL SOUND(-25,1122,4):: NEXT T
1320 CALL PATTERN(#3,128):: FOR T=1 TO 5 :: CALL SOUND(-99,500*T,2+T):: NEXT T
1330 CALL SOUND(50,4000,2):: CALL DELSPRITE(#3):: SH=0 :: SCORE=SCORE+10 :: DISPLAY AT(23,24):SCORE :: GOTO 660
1340 REM**DESTROY HERO**
1350 CALL DELSPRITE(#3):: CALL MOTION(#1,0,0)
1360 FOR T=1 TO 5 :: CALL COLOR(#1,2):: CALL SOUND(-99,750,2)
1370 CALL COLOR(#1,16):: CALL SOUND(-99,775,4):: NEXT T
1380 CALL PATTERN(#1,128):: FOR T=5 TO 1 STEP -1 :: CALL SOUND(-99,450*T,1+T):: NEXT T
1390 CALL DELSPRITE(#1):: ARMOR=ARMOR-1 :: DISPLAY AT(24,8)SIZE(3):ARMOR :: IF ARMOR<1 THEN 1440 ELSE 650
1400 REM **OBTAIN OXYGEN**
1410 CALL DELSPRITE(#4):: CALL SOUND(100,200,3,300,4):: OF=0 :: OXYGEN=OXYGEN+10
1420 DISPLAY AT(22,7)SIZE(4):OXYGEN :: GOTO 1060
1430 REM **END GAME**
1440 CALL DELSPRITE(ALL)
1450 FOR T=10 TO 2 STEP -1
1460 CALL SOUND(-1000,-7,T):: CALL SCREEN(12):: CALL COLOR(1,12,12,2,12,12,11,12,12,12,12,12,13,12,12)
1470 CALL SOUND(-1000,-7,T-1):: CALL SCREEN(9):: CALL COLOR(1,9,9,2,9,9,11,9,9,12,9,9,13,9,9)
1480 NEXT T
1490 CALL SCREEN(2):: CALL COLOR(1,2,2,2,2,2,11,2,2,12,2,2,13,2,2)
1500 FOR T=1 TO 5 :: CALL SOUND(-1000,1000+(200*T),T):: NEXT T
1510 CALL SOUND(100,125,1)
1520 IF OXYGEN<1 THEN DISPLAY AT(8,10)ERASE ALL:"OUT OF OXYGEN"
1530 IF ARMOR<1 THEN DISPLAY AT(8,10)ERASE ALL:"OUT OF ARMOR"
1540 IF HIT5=-1 THEN DISPLAY AT(8,10)ERASE ALL:"ANTIMATTER HIT!"
1550 DISPLAY AT(12,10)SIZE(5):"SCORE" :: DISPLAY AT(12,17):SCORE
1560 IF SCORE>HIGH THEN HIGH=SCORE
1570 DISPLAY AT(14,10)SIZE(4):"HIGH" :: DISPLAY AT(14,17):HIGH
1580 DISPLAY AT(19,10):"GAME OVER"
1590 DISPLAY AT(21,5):"PLAY AGAIN? Y OR N"
1600 CALL KEY(0,K,S):: IF K=89 OR K=121 THEN CALL CLEAR :: GOTO 350
1610 IF K=78 OR K=110 THEN 1750 ELSE 1600
1620 LEVEL=LEVEL+1 :: PN=0 :: IF LEVEL>5 THEN 1630 ELSE 590
1630 CALL CLEAR :: CALL SCREEN(2):: CALL DELSPRITE(ALL)
1640 CALL SOUND(200,262,4):: CALL SOUND(200,330,4):: CALL SOUND(200,392,4):: CALL SOUND(100,523,3)
1650 CALL SOUND(150,523,30):: CALL SOUND(200,302,3):: CALL SOUND(500,330,2,392,2,523,2)
1660 CALL SOUND(200,131,2,165,2,196,2)
1670 DISPLAY AT(8,7):"CONGRATULATIONS !" :: DISPLAY AT(11,6):"YOU HAVE JUST SAVED"
1680 DISPLAY AT(12,6):"THE REACTOR AND THE" :: DISPLAY AT(13,7):"ENTIRE WOLRD FROM"
1690 DISPLAY AT(14,6):"COMPLETE DESTRUCTION."
1700 DISPLAY AT(16,6):"YOUR MOTHER WOULD BE" :: DISPLAY AT(17,11):"PROUD !!!" ::
 DISPLAY AT(20,3):"PLAY AGAIN?"
1710 DISPLAY AT(21,4):"PRESS Y OR N"
1720 DISPLAY AT(5,3):"SCORE ";SCORE
1730 CALL KEY(0,K,S):: IF K=89 THEN CALL CLEAR :: GOTO 350
1740 IF K=78 THEN 1750 ELSE 1730
1750 END
1760 REM **HERO MOVE SUB**
1770 IF K1<>1 THEN 1800
1780 CALL JOYST(1,XR,YR):: IF XR=0 AND YR<>0 THEN CALL MOTION(#1,-YR*4,0):: GOTO 1820
1790 CALL MOTION(#1,0,0):: RETURN
1800 CALL KEY(0,K,S):: IF K=69 THEN CALL MOTION(#1,-16,0):: GOTO 1820
1810 IF K=88 THEN CALL MOTION(#1,16,0):: GOTO 1820 ELSE CALL MOTION(#1,0,0):: RETURN
1820 IF HP=0 THEN CALL PATTERN(#1,100):: CALL SOUND(3,-3,2):: CALL SOUND(20,-7,10):: HP=1 :: RETURN
1830 CALL PATTERN(#1,96):: CALL SOUND(3,-3,2):: CALL SOUND(20,-6,10):: HP=0 :: RETURN
1840 REM **SHOOT SUB**
1850 IF SH=1 THEN RETURN
1860 IF K1<>1 THEN 1880
1870 CALL JOYST(1,XR,YR):: IF XR=0 THEN RETURN ELSE 1890
1880 CALL KEY(O,K,S):: IF K<>68 AND K<>83 THEN RETURN
1890 CALL POSITION(#1,DR,DC):: Z=INT(((DR-1)/12)-.05):: IF Z<1 OR Z>12 THEN RETURN
1900 IF K1<>1 THEN 1920
1910 IF XR=4 THEN 1930 ELSE 1940
1920 IF K=83 THEN 1940
1930 CALL SPRITE(#2,104,16,MP(Z),122,0,16):: CALL SOUND(100,500,2):: SH=1 :: RETURN
1940 CALL SPRITE(#2,104,16,MP(Z),107,0,-16):: CALL SOUND(100,500,2):: SH=1 :: RETURN
1950 REM *CALL SCREEN GOSUB*
1960 ON LEVEL GOTO 1970,1980,1990,2000,2010
1970 RETURN
1980 CALL SCREEN(13):: RETURN
1990 CALL SCREEN(5):: RETURN
2000 CALL SCREEN(14):: RETURN
2010 CALL SCREEN(10);;RETURN
2020 REM **DATA**
2030 DATA 25,14,1,49,14,1,73,14,1,97,14,1,121,14,1,145,14,1
2040 DATA 25,237,-1,49,237,-1,73,237,-1,97,237,-1,121,237,-1,145,237,-1
2050 DATA 25,25,49,49,73,73,97,97,121,121,145,145
2060 DATA 25,120,49,120,73,120,97,120,121,120,145,120
2070 DATA 3,1,3,19,21,1,21,19
2080 DATA 6,1,6,19,9,1,9,19,12,1,12,19,15,1,15,19,18,1,18,19
2090 DATA 1,14,1,19,22,14,22,19
2100 DATA 5,3,116,14,16,116,8,16,124,17,3,124,11,3,132,20,16,132
2110 DATA 25,14,97,237,49,237,121,14,73,14,145,237