Little Nero Posted August 20, 2018 Share Posted August 20, 2018 I'm new to programming so I was wondering if anyone had the source code for TI-99/4a games written in BASIC? Quote Link to comment Share on other sites More sharing options...
+chue Posted August 20, 2018 Share Posted August 20, 2018 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. 2 Quote Link to comment Share on other sites More sharing options...
Little Nero Posted August 21, 2018 Author Share Posted August 21, 2018 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. Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 9, 2018 Share Posted September 9, 2018 (edited) 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 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 9, 2018 Share Posted September 9, 2018 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 Quote Link to comment Share on other sites More sharing options...
+OLD CS1 Posted September 9, 2018 Share Posted September 9, 2018 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. 3 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 12, 2018 Share Posted September 12, 2018 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 ! 1 Quote Link to comment Share on other sites More sharing options...
HOME AUTOMATION Posted September 12, 2018 Share Posted September 12, 2018 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... :? Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 12, 2018 Share Posted September 12, 2018 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. :-) 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 12, 2018 Share Posted September 12, 2018 (edited) 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 2 Quote Link to comment Share on other sites More sharing options...
HOME AUTOMATION Posted September 12, 2018 Share Posted September 12, 2018 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) Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 18, 2018 Share Posted September 18, 2018 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 4 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted September 20, 2018 Share Posted September 20, 2018 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 2 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted August 4, 2020 Share Posted August 4, 2020 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 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.