oddemann Posted April 22, 2019 Share Posted April 22, 2019 (edited) COMPUTEs_Programmers_Reference_Guide_to_the_TI-99_4A_1983 - C.Regena How the Program Works Naturally, some characters were defined in order to create the screen display in this program. Character 97, a, is fe-defined as an open square, 0 , and Character 98, b, is defined as a filled square, • (lines 200-210). When the 8x8 grid is drawn on the screen, it is done by printing the string "aaaaaaaa" eight times (lines 420-440). The character codes as they will appear on the screen are READ in as DATA (lines 120-170). The string array H$(O,l) through H$(lS,1) holds the sixteen patterns of blank (" a") or filled-in ("b" ) squares. The string array H$(0,2) through H$(15,2) holds the corresponding code number or letter as you would use it in your programs later. The flashing cursor is red so that you can tell where you are on the pattern you are designing (lines 180-190). CALL GCHAR(X,Y,C) determines what character number C is at row X and column Y (line 480). Spoiler 110 REM DEFINING CHARACTERS 120 DIM H$(15,2) 130 FOR I=0 TO 15 140 READ H$(I,1),H$(I,2) 150 NEXT I 160 DATA aaaa,0,aaab,1,aaba,2,aabb,3,abaa,4,abab,5,abba,6,abbb,7,baaa,8,baab,9 170 DATA baba,A,babb,B,bbaa,C,bbab,D,bbba,E,bbbb,F 180 CALL COLOR(13,9,1) 190 CALL CHAR(128,"FFFFFFFFFFFFFFFF") 200 CALL CHAR(97,"FF818181818181FF") 210 CALL CHAR(98, "FFFFFFFFFFFFFFFF") 220 CALL CLEAR 230 PRINT "DEFINE A GRAPHICS CHARACTER" 240 PRINT :"PRESS F TO FILL THE SQUARE" 250 PRINT "PRESS SPACE TO CLEAR SQUARE" 260 PRINT "PRESS ARROW KEYS TO MOVE" 270 PRINT :"PRESS ENTER WHEN FINISHED": : : 280 IF (K=50)+(K=0) THEN 420 290 FOR I=1 TO 15 STEP 2 300 FOR L=0 TO 15 310 IF SEG$(D$,I,1)=H$(L,2) THEN 330 320 NEXT L 330 C$=H$(L,1) 340 PRINT " ";C$; 350 FOR L=0 TO 15 360 IF SEG$(D$,I+1,1)=H$(L,2) THEN 380 370 NEXT L 380 C$=H$ (L,1) 390 PRINT C$ 400 NEXT I 410 GOTO 450 420 FOR I=1 TO 8 430 PRINT " aaaaaaaa" 440 NEXT I 450 X=16 460 Y=6 470 CALL SOUND(150,1397,2) 480 CALL GCHAR(X,Y,C) 490 CALL KEY(0,K,S) 500 CALL HCHAR(X,Y,128) 510 CALL HCHAR(X,Y,C) 520 IF S<0 THEN 490 530 IF K=13 THEN 760 540 IF K=70 THEN 740 550 IF K=32 THEN 720 560 IF K<>68 THEN 600 570 IF Y=13 THEN 470 580 Y=Y+1 590 GOTO 480 600 IF K<>88 THEN 640 610 IF X=23 THEN 470 620 X=X+1 630 GOTO 480 640 IF K<>83 THEN 680 650 IF Y=6 THEN 470 660 Y=Y- 1 670 GOTO 480 680 IF K<>69 THEN 490 690 IF X=16 THEN 470 700 X=X-1 710 GOTO 480 720 CALL HCHAR(X,Y,97) 730 GOTO 470 740 CALL HCHAR(X,Y,98) 750 GOTO 470 760 CALL SOUND(150,440,2) 770 D$="" 780 FOR I=1 TO 8 790 C$="" 800 FOR J=6 TO 9 810 CALL GCHAR(I+15,J,C) 820 C$=C$&CHR$(C) 830 NEXT J 840 GOSUB 1050 850 CALL HCHAR(I+15,16,ASC(D1$)) 860 D$=D$&D1$ 870 C$="" 880 FOR J=10 TO 13 890 CALL GCHAR(I+15,J,C) 900 C$=C$&CHR$(C) 910 NEXT J 920 GOSUB 1050 930 CALL HCHAR(I+15,17,ASC(D1$)) 940 D$=D$&D1$ 950 NEXT I 960 CALL CHAR(136,D$) 970 CALL HCHAR(20,20,136) 980 PRINT : "DEFINITION = ";D$ 990 PRINT : :"PRESS 1 TO MODIFY" 1000 PRINT " 2 TO START OVER" 1010 PRINT " 3 TO END PROGRAM"; 1020 CALL KEY(0,K,S) 1030 IF (K=49)+(K=50) THEN 220 1040 IF K=51 THEN 1110 ELSE 1020 1050 FOR L=0 TO 15 1060 IF C$=H$(L,1) THEN 1090 1070 NEXT L 1080 L=L-1 1090 D1$=H$(L,2) 1100 RETURN 1110 PRINT : : 1120 END Edited October 18, 2022 by oddemann Fixed bug! And NOW Tags! 1 Quote Link to comment Share on other sites More sharing options...
Retrospect Posted April 22, 2019 Share Posted April 22, 2019 The cursor doesn't fit the grid properly, I don't know what the culprit is but I think line 460 and maybe a line that determines how many to the left the cursor can go needs altering? Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 8, 2019 Author Share Posted May 8, 2019 LARRY'S TEN FIDDLE TUNES (Tl) Explanation of the Program Line Nos. 100-180 Program header. 190-250 Initialization. 260-280 Change color of lower case letters. 290-500 Print menu. 510-620 Select from menu; print pertinent information from array to bottom of screen. 630-1430 Ten subroutines for the ten songs. 1440 Print a blank line in menu for readability. 1450-1570 Draw head of instrument and strings for tuning utility. 1580-1610 Choose string to tune. 1620 Leave tuning section when O is pressed. 1630-1770 Note, frequency and row placement information for tuning peg. 1780 CALL SOUND for tuning (negative duration allows interrupt). 1790-1930 Draw peg to turn. 1940 Display letter of note on peg. 1950 Loop to stay in tuning routine. 1960-2030 Change playing speed. 2040-2140 End message. 2150-2190 Print message subroutine. 2150-2310 Play music subroutine. 2320-3340 DATA for music. Home Computer Magazine Vol 4 Nr 1 -1984http://www.ti99iuc.it/web/index.php?pageid=database_cerca&archivioid=283&fbclid=IwAR0RgDrAGwX_-jNpDCEQDINoMf2SHcmQOf_mBXBehiuxj3e4Tg-AwC9Lgqo#.XNKUNiLVKUkNot all data is in yet. If you want, you can add data 100 REM 110 REM LARRY'S TEN 120 REM FIDDLE TUNES 130 REM ****************** 140 REM BY LARRY SCHOTT 150 REM HOE CO PUTER AGAZINE 160 REM VERSION 4.1.1 170 REM TI BASIC 180 REM 190 REM 200 SP=175 210 CALL SCREEN ( 220 CALL CHAR(33,"E7E7E7E7E7E7E7E7") 230 CALL CHAR(44,"FFFFFFFFFFFFFFFF") 240 CALL CHAR(95,"0808080868F8F060") 250 DIM A$(14) 260 FOR X=9 TO 11 270 CALL COLOR(X,5,1) 280 NEXT X 290 REM 300 FOR X=1 TO 17 STEP 8 310 CALL HCHAR(X,1,95,256) 320 NEXT X 330 RESTORE 340 CALL HCHAR(24,1,32,32) 350 FOR X=1 TO 3 360 IF X<>2 THEN 390 370 PRINT TAB(5);"LARRY’S FIDDLER TUNES " 380 GOTO 400 390 PRINT 400 CALL HCHAR(23,1,95,4) 410 CALL HCHAR(23,29,95,4) 420 NEXT X 430 FOR X=1 TO 14 440 READ T$,M$ 450 A$(X)=M$ 460 PRINT TAB(3);T$ 470 CALL HCHAR(23,1,95,4) 480 CALL HCHAR(23,29,95,4) 490 NEXT X 500 PRINT 510 REM 520 M$="SELECTION: KEY: 1ST NOTE:" 530 C=2 540 GOSUB 2150 550 INPUT " ":S 560 IF (S<1)+(S>13) THEN 550 570 M$=A$(S) 580 C=16 590 GOSUB 2150 600 X=0 610 ON S GOSUB 640,720,800,880,960,1040,1120,1200,1280,1360,1460,1970,2050 620 GOTO 290 630 REM 640 DATA " (1) SOLDIER’S JOY",D F# ON 3 650 RESTORE 2340 660 GOSUB 2210 670 IF X<2 THEN 650 680 RESTORE 2410 690 GOSUB 2210 700 IF X<4 THEN 680 710 RETURN 720 DATA " (2) ARKANSAS TRAVELLER",D A# ON 4 730 RESTORE 2470 740 GOSUB 2210 750 IF X<2 THEN 730 760 RESTORE 770 GOSUB 2210 780 IF X<4 THEN 760 790 RETURN 800 DATA " (3) CINCINATI HORNPIPE",D D/OPEN 3 810 RESTORE 2570 820 GOSUB 2210 830 IF X<2 THEN 810 840 RESTORE 2630 850 GOSUB 2210 860 IF X<4 THEN 840 870 RETURN 880 DATA " (4) POP GOES THE WEASEL",G G ON 3 890 RESTORE 2680 900 GOSUB 2210 910 IF X<2 THEN 890 920 RESTORE 2720 930 GOSUB 2210 940 IF X<4 THEN 920 950 RETURN 960 DATA" (5) GARRY OWEN",G G ON 1 970 RESTORE 2760 980 GOSUB 2210 990 IF X<2 THEN 970 1000 RESTORE 2810 1010 GOSUB 2210 1020 IF X<4 THEN 1000 1030 RETURN 1040 DATA" (6) COCK AND HEN",G B ON 2 1050 RESTORE 2860 1060 GOSUB 2210 1070 IF X<2 THEN 1050 1080 RESTORE 2900 1090 GOSUB 2210 1100 IF X<4 THEN 1080 1110 RETURN 1120 DATA" (7) TOM & JERRY REEL",D A/OPEN 2 1130 RESTORE 2940 1140 GOSUB 2210 1150 IF X<2 THEN 1130 1160 RESTORE 3000 1170 GOSUB 2210 1180 IF X<4 THEN 1160 1190 RETURN 1200 DATA " ( IRISH WASHERWOMAN",G D ON 2 1210 RESTORE 3060 1220 GOSUB 2210 1230 IF X<2 THEN 1210 1240 RESTORE 3110 1250 GOSUB 2210 1260 IF X<4 THEN 1240 1270 RETURN 1280 DATA" (9) MC DONALD'S",G B ON 2 1290 RESTORE 3160 1300 GOSUB 2210 1310 IF X<2 THEN 1290 1320 RESTORE 3210 1330 GOSUB 2210 1340 IF X<4 THEN 1320 1350 RETURN 1360 DATA "(10) TWO FORTY REEL",G D/OPEN 3 1370 RESTORE 3250 1380 GOSUB 2210 1390 IF X<2 THEN 1370 1400 RESTORE 3290 1410 GOSUB 2210 1420 IF X<4 THEN 1400 1430 RETURN 1440 DATA "","" 1450 REM 1460 DATA (11) tune the fiddle,"" 1470 REM 1480 CALL CLEAR 1490 PRINT " PRESS NUMBER"::" OF STRING TO"::" BE TUNED."::: 1500 PRINT " PRESS (0)"::" FOR MENU.":::::: 1510 CALL VCHAR(1,22,33,96) 1520 CALL VCHAR(1,22,44,10) 1530 CALL VCHAR(1,23,44,6) 1540 CALL VCHAR(1,24,44,4) 1550 CALL VCHAR(1,25,44, 1560 CALL HCHAR(14,22,44,4) 1570 PRINT TAB(20); "4321" 1580 CALL KEY(0,K,S) 1590 IF (S=0)+(K<48)+(K>52)THEN 1580 1600 ON (K-47)GOSUB 1620,1630,1670,1710, 1750 1610 GOTO 1580 1620 GOTO 300 1630 N=69 1640 F=659 1650 R=7 1660 GOTO 1780 1670 N=65 1680 F=440 1690 R=3 1700 GOTO 1780 1710 N=68 1720 F=294 1730 R=5 1740 GOTO 1780 1750 N=71 1760 F=196 1770 R=9 1780 CALL SOUND(-SP*20,F,1) 1790 IF K>50 THEN 1840 1800 C=27 1810 GOSUB 1880 1820 CALL HCHAR(R-2,C-1,44) 1830 GOTO 1940 1840 C=18 1850 GOSUB 1880 1860 CALL HCHAR(R-2,C+3,44) 1870 GOTO 1940 1880 REM DISPLAY PEG 1890 FOR X=1 TO 3 1900 CALL HCHAR(R,C,44,3) 1910 R=R+1 1920 NEXT X 1930 RETURN 1940 CALL HCHAR(R-2,C+1,N) 1950 GOTO 1580 1960 REM 1970 DATA (12) change speed,"" 1980 REM 1990 M$="SPEED 50-500 (HIGHER=SLOWER)" 2000 C=2 2010 GOSUB 2160 2020 INPUT " ":SP 2030 RETURN 2040 REM 2050 DATA (13) END,"" 2060 REM 2070 CALL CLEAR 2080 PRINT "_ NEXT TIME – DOUBLE NOTES _"::::::::::: 2090 RESTORE 3340 2100 GOSUB 2210 2110 CALL SOUND(INT(SP*2),440,2,554,0) 2120 CALL SOUND(INT(SP*,294,8,587,0) 2130 CALL CLEAR 2140 STOP 2150 REM 2160 FOR X=1 TO LEN(M$) 2170 CALL HCHAR(23,C+X,ASC(SEG$(M$,X,1))) 2180 NEXT X 2190 RETURN 2200 REM 2210 READ D 2220 IF D=99 THEN 2300 2230 IF D<110 THEN 2240 ELSE 2260 2240 READ F 2250 GOTO 2280 2260 F=D 2270 D=1 2280 CALL SOUND(INT(SP*D),F,1) 2290 GOTO 2210 2300 X=X+1 2310 RETURN 2320 REM 2330 REM 2340 REM SJ 2350 DATA 370,392,440,370,294,370,440,370,294,370,2,440,2,587,2,587 2360 DATA 554,494,440,370,294,370,440,370,294,370,2,392,2,330,2,330 2370 DATA 370,392,440,370,294,370,440,370,294,370,2,440,2,587,2,587 2380 DATA 659,784,740,880,740,587,659,784,659,554,2,587,2,587,2,587 2390 DATA 99 2400 REM SJ2 2410 DATA 587,659,740,659,587,659,740,880,784,740,659,587,554,587,659,740 2420 DATA 784,659,740,659,587,659,740,784,880,740,659,587,554,494,2,440 2430 DATA 2,784,740,659,587,659,740,784, 880,740,659,587,554,587,659,740 2440 DATA 784,659,740,880,740,587,659,784,659,554,2,587,2,587,2,587 2450 DATA 99 2460 REM AT 2470 DATA 220,247,277,294,370,330,294,2,247,2,247,2,220,2,220,4 2480 DATA 294,330,330,2,330,370,370,2,370,294,370,330,294,2,247,2 2490 DATA 220,294,370,330,294,2,247,2,247,2,220,2,220,4,294,587 2500 DATA 554,587,440,494,587,440,392,370,330,294,277,2,294,99 2510 REM AT2 2520 DATA 880,784,740,880,784,740,659,784,740,659,587,740,659,587,554,440 2530 DATA 587,554,587,740,659,587,659,784,740,659,587,740,2,659,740,784 2540 DATA 880,784,740,880,784,740,659,784,740,659,587,740,659,587,554,440 2550 DATA 587,554,587,440,494,587,440,392,370,330,294,277,4,294,99 2560 REM CH 2570 DATA 294,440,370,440,294,440,370,440,587,440,740,440,659,440,740,440 2580 DATA 784,440,740,440,659,587,554,587,659,587,554,494,440,392,370,330 2590 DATA 294,440,370,440,294,440,370,440,587,440,740,440,659,441,740,440 2600 DATA 784,440,740,440,659,587,554,494,554,587,659,784,740,587,2,587 2610 DATA 99 2620 REM CH2 2630 DATA 659,440,440,440,740,440,440,440,784,440,440,440,740,440,440,440 2640 DATA 659,440,740,440,784,440,740,440,659,587,554,494,440,392,370,330 2650 DATA 294,587,587,587,554,659,659,659,587,740,740,740,659,784,784,784 2660 DATA 740,784,880,740,988,784,659,554,2,587,2,587,3,587,99 2670 REM PGTW 2680 DATA 2,392,392,2,440,440,494,587,494,2,392,22222,2,392,392,2 2690 DATA 440,523,3,494,2,392,22222,2,392,392,2,440,440,494,587,494 2700 DATA 2710 REM 2720 DATA 2730 DATA 2740 DATA 2750 REM 2760 DATA 2770 DATA 2780 DATA 2790 DATA 2800 REM 2810 DATA 2820 DATA 2830 DATA 2840 DATA 2850 REM 2860 DATA 2870 DATA 2880 DATA 2890 REM 2900 DATA 2910 DATA 2920 DATA 2930 REM 2940 DATA 2950 DATA 2960 DATA 2970 DATA 2980 DATA 2990 REM 3000 DATA 3010 DATA 3020 DATA 3030 DATA 3040 DATA 3050 REM 3060 DATA 3070 DATA 3080 DATA 3090 DATA 3100 REM 3110 DATA 3120 DATA 3130 DATA 3140 DATA 3150 REM 3160 DATA 3170 DATA 3180 DATA 3190 DATA 3200 REM 3210 DATA 3220 DATA 3230 DATA 3240 REM 3250 DATA 3260 DATA 3270 DATA 3280 REM 3290 DATA 3300 DATA 3310 DATA 3320 DATA 3330 REM END 3340 DATA 2,587,.7,440,.7,440,2,494,2,440,2,22222,99 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 9, 2019 Author Share Posted May 9, 2019 (edited) From: TI collection volume one http://aa-ti994a.oratronik.de/ti-collection-volume-one.pdf Example Animated Program The following BASIC program uses the techniques described in this article to produce an animated game. The object of the game is to maneuver the marble into the hole at the opposite corner of the display. Between the marble and the hole are two to five kids trying to catch the marble. The kids can only be seen at the start of the game or when one is close to the marble. The arrow keys on the keyboard are used to maneuver the marble. 100 REM * 110 REM * DEFINE PLAYERS 120 REM * 130 BGC=8 140 SQUARE=128 150 SQR$="0000000000000000" 160 CALL CHAR(SQUARE,SQR$) 170 CALL COLOR(13,1,BGC) 180 KID=136 190 KD1$="1898FF3D3C3CE404" 200 KD2$="1819FFBC3C3C2720" 210 CALL CHAR(KID,KD1$) 220 CALL COLOR(14,2,BGC) 230 MARBLE=144 240 MRB$="003C7E7E7E7E3C00" 250 CALL CHAR(MARBLE,MRB$) 260 CALL COLOR(15,16,BGC) 270 HOLE=152 280 HOL$="FFC381818181C3FF" 290 CALL CHAR(HOLE,HOL$) 300 CALL COLOR(16,2,1) 310 REM 320 REM * DISPLAY BOARD 330 REM * 340 CALL CLEAR 350 CALL SCREEN(10) 360 C=7 370 L=20 380 FOR R=3 TO 22 390 CALL HCHAR(R,C,SQUARE,L) 400 NEXT R 410 REM * 420 REM * POSITION KIDS 430 REM * 440 DIM KR(10),KC(10) 450 RANDOMIZE 460 KN=INT(4*RND)+2 470 FOR N=1 TO KN 480 KR(N)=INT(20*RND)+3 490 KC(N)=INT(20*RND)+7 500 CALL HCHAR(KR(N),KC(N),KID) 510 NEXT N 520 REM * 530 REM * POSITION HOLE 540 REM * 550 HR=4 560 HC=8 570 CALL HCHAR(HR,HC,HOLE) 580 REM * 590 REM * POSITION MARBLE 600 REM * 610 MR=21 620 MC=25 630 CALL HCHAR(MR,MC,MARBLE) 640 REM * 650 REM * WAIT FOR KEY 660 REM * 670 CALL KEY(1,KEY,STATUS) 680 IF STATUS=0 THEN 670 690 CALL COLOR(14,BGC,BGC) 700 REM * 710 REM * BEGIN GAME 720 REM * 730 CALL CHAR(KID,KD1$) 740 CALL KEY(1,KEY,STATUS) 750 IF STATUS=0 THEN 970 760 J=1 770 IF STATUS>0 THEN 790 780 J=2 790 IF KEY>5 THEN 970 800 REM * 810 REM * MOVE MARBLE 820 REM * 830 CALL HCHAR(MR,MC,SQUARE) 840 ON KEY+1 GOTO 850,970,870,890,970,910 850 MR=MR+0 860 GOTO 920 870 MC=MC-J 880 GOTO 920 890 MC=MC+J 900 GOTO 920 910 MR=MR-J 920 IF (MR=HR)*(MC=HC) THEN 1210 930 CALL HCHAR(MR,MC,MARBLE) 940 REM * 950 REM * MOVE KIDS 960 REM * 970 CALL CHAR (KID,KD2$) 980 FOR I=1 TO KN 990 CALL HCHAR(KR(I),KC(I),SQUARE) 1000 IF KR(I)=MR THEN 1050 1010 IF KR(I)<MR THEN 1040 1020 KR(I)=KR(I)-1 1030 GOTO 1050 1040 KR(I)=KR(I)+1 1050 IF KC(I)=MC THEN 1100 1060 IF KC(I)<MC THEN 1090 1070 KC(I)=KC(I)-1 1080 GOTO 1100 1090 KC(I)=KC(I)+1 1100 CALL HCHAR(KR(I),KC(I),KID) 1110 IF (KR(I)=MR)*(KC(I)=MC) THEN 1320 1120 R=ABS(KR(I)-MR) 1130 C=ABS(KC(I)-MC) 1140 IF (R+C>4)THEN 1160 1150 CALL COLOR(14,2,BGC) 1160 NEXT I 1170 GOTO 730 1180 REM * 1190 REM * PLAYER WINS 1200 REM * 1210 CALL COLOR(16,2,16) 1220 FOR I=0 TO 1 1230 FOR J=-1 TO -4 STEP -1 1240 CALL SCREEN(I*8-J*2) 1250 CALL SOUND(500,J,1) 1260 NEXT J 1270 NEXT I 1280 GOTO 100 1290 REM * 1300 REM * PLAYER LOSES 1310 REM * 1320 CALL COLOR(15,7,BGC) 1330 CALL HCHAR(MR,MC,MARBLE) 1340 FOR J=-5 TO -7 STEP -1 1350 CALL SOUND(100,J,1) 1360 NEXT J 1370 GOTO 100 Edited May 9, 2019 by oddemann Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 9, 2019 Author Share Posted May 9, 2019 (edited) From same PDF as above! Sound Shaper Steven Kaye - TI Translation by Patrick Parrish "Sound Shaper" manipulates volume and frequency to give the TI with Extended BASIC a smoother, more musical sound.. The program also runs on the TI with regular BASIC. The TI produces waveforms which are square. One micro second the sound is off, the next it's on. This abrupt onset of sound produces somewhat nonmusical sounds. The tones sound electronic and unlike any acoustic instrument. As an alternative to turning the sound on and off abruptly, we can increase and decrease the amplitude (vol ume) more gradually under control of the program. "Sound Shaper" has two sound producing routines that can be used in your programs. Echo effect produces a sound that its name implies. The actual routine producing the sound is in lines 550 to 670. The routine can be extracted as is and used. The Shaped Musical Notes routine is a bit more flexible. The program will ask for a rise and fall value. Experiment with different values. Try low values like .5,2 and .1,1 and higher values like 10,10. For an eerie sound try 5,20. If the in put values are much higher the program seems to continue endlessly, but will eventually return to the main menu. Experiment with values and write down the ones you like. Once you have found the effect you wantfor a particular application, copy the routine from lines 400 to 490. Be sure to supply values for R and D. Spoiler 100 CALL CLEAR 110 CALL SCREEN(15) 120 PRINT TAB(7):"SHAPING TI SOUNDS" 130 FOR T=1 TO 6 140 PRINT 150 NEXT T 160 PRINT "CHOOSE:" 170 PRINT 180 PRINT 190 PRINT TAB(4);"1) SHAPED MUSICAL NOTES" 200 PRINT 210 PRINT TAB(4);"2) ECHO" 220 PRINT 230 PRINT TAB(4);"3) QUIT" 240 PRINT 250 INPUT A$ 260 IF (VAL(A$)<1)+(VAL(A$)>3) THEN 250 270 ON VAL(A$) GOTO 290,520,690 280 REM THIS PART PRODUCES "SHAPED" MUSICAL NOTES 290 CALL CLEAR 300 CALL SCREEN(13) 310 PRINT TAB(3);"«* SHAPED MUSICAL NOTES *" 320 FOR T=1 TO 10 330 PRINT 340 NEXT T 350 PRINT "ENTER RISE AND FALL TIMES -" 360 PRINT "USE VALUES GREATER THAN ZERO (X,X)"; 370 PRINT 380 INPUT R,D 390 IF (R=0)+(D=0)THEN 380 400 FOR F=110 TO 880 STEP 30 410 FOR DB=30 TO 0 STEP -5/R 420 CALL SOUND(-10,F.DB) 430 NEXT DB 440 FOR DB=0 TO 30 STEP 5/D 450 CALL SOUND(-10,F,DB) 460 NEXT DB 470 FOR T=1 TO 50 480 NEXT T 490 NEXT F 500 GOTO 100 510 REM THIS PART CREATES AN ECHO EFFECT 520 CALL CLEAR 530 CALL SCREEN(14) 540 PRINT TAB(8);"* ECHO EFFECT *" 550 FOR T=1 TO 12 560 PRINT 570 NEXT T 580 FOR F=110 TO 880 STEP 30 590 FOR DB=1 TO 30 600 CALL SOUND(-10,F,DB) 610 FOR T=1 TO 10 620 NEXT T 630 CALL SOUND(-10,990-F,DB) 640 FOR J=1 TO 10 650 NEXT J 660 NEXT DB 670 NEXT F 680 GOTO 100 690 END Edited October 15, 2022 by oddemann Fixed bug! 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 9, 2019 Author Share Posted May 9, 2019 (edited) Again PDF above!The Mozart Machine Donald J. Eddington TI Translation by Gregg Peele Your computer can compose music with this special tech nique. The compositions are remarkably Mozartian in style. If you've ever gone through the steps to make your computer play a particular piece of music, you realize that it can be a significant programming task. To have your computer actually write music is a real feat. To accomplish this, we've first got to find a way to work with CALL SOUND values in DATA statements in order to make the measures of music. Also, we need to be able to READ the values in any order so that the songs will be dif ferent with each run of the program. The commonly used string manipulation methods won't work very well here. We need variety, and the traditional way of working with strings quickly results in a tangled mess. Array Referencing The shortest, best way to solve this problem is to use a tech nique called array referencing. First, to get the measures of music, you set up an array of all variables, then reference them by subscript in a loop. Specifically, 14 variations on nine variables are required to make the music for this program. The random number generator is used to make the music different every time the program is run. A Mozartian flavor results from a deliberate shortening of the low notes and making the high notes of varying lengths. And to keep the music from becoming totally random, DATA statements select the measures by their underlying tonality— tonic, subdominant, dominant, or supertonic. In keeping with classical style, a cadence is provided every four measures with a final ending chord for each tune. TI Mozart Spoiler 100 DIM X(14,9) 110 REM THE TICLANG 120 CALL CLEAR 130 CALL SCREEN(14) 140 PRINT " WELCOME! I AM TICLANG" 150 PRINT " AMAZIUS MOZART" 160 PRINT 170 PRINT "I PLAY SONGS LIKE THE CHILD" 180 PRINT "PRODIGY, WOLFGANG AMADEUS " 190 PRINT " MOZART MIGHT HAVE DONE." 200 PRINT 210 PRINT " MOZART LIVED FROM" 220 PRINT " 1756 TO 1791" 230 PRINT " AND WROTE OVER 626 WORKS IN" 240 PRINT " 31 YEARS." 250 PRINT 260 PRINT "THE 5 PIECES YOU HEAR ARE" 270 PRINT " BEING WRITTEN BY" 280 PRINT " COMPUTER AS YOU LISTEN!" 290 PRINT 300 PRINT 310 PRINT 320 FOR T=1 TO 14 330 FOR TT=1 TO 9 340 READ X(T,TT) 350 NEXT TT 360 NEXT T 370 DATA 196,494,494,247,494,587,294,494,220 380 DATA 196,494,587,247,587,523,294,494,294 390 DATA 196,494,523,247,587,523,294,494,294 400 DATA 196,523,587,262,659,784,330,784,262 410 DATA 196,523,659,262,392,659,330,523,262 420 DATA 196,659,523,262,392,659,330,523,196 430 DATA 220,523,587,262,784,587,294,523,220 440 DATA 220,440,587,220,523,494,294,440,262 450 DATA 220,659,784,262,587,523,294,494,220 460 DATA 220,523,494,262,440,494,330,523,220 470 DATA 220,523,494,262,440,494,330,523,262 480 DATA 196,494,523,247,587,587,294,587,294 490 DATA 196,587,523,220,440,440,294,440,220 500 DATA 196,659,587,262,523,523,330,523,262 510 P=250 520 DATA 1,3,6,2,1,4,6,2,3,4,1,5,1,4,6,7,1,4,6,2,1,3,6,9 530 DATA 1,1,4,5,1,4,6,2,3,4,1,5,1,4,1,5,1,4,6,9 540 DATA 1,4,6,2,3,6,1,5,1,4,6,7,3,4,6,2,1,4,3,7,1,4,6,9 550 DATA 1,4,3,7,1,6,4,5,6,3,6,2,4,6,1,5,1,4,6,9 560 DATA 1,4,3,7,6,3,6,2,4,6,1,5,1,3,6,7,3,6,1,5,1,4,6,9,8 570 READ RR 580 ON RR GOTO 650,590,730,780,610,860,640,940,1040 590 Y=12 600 GOTO 990 610 Y=14 620 GOTO 990 630 Y=13 640 GOTO 990 650 Y=1 660 RANDOMIZE 670 IF RND>.35 THEN 700 680 Y=3 690 RANDOMIZE 700 IF RND<.75 THEN 720 710 Y=2 720 GOTO 990 730 Y=10 740 RANDOMIZE 750 IF RND>.4 THEN 780 760 Y=11 770 GOTO 990 780 Y=4 790 RANDOMIZE 800 IF RND>.35 THEN 820 810 Y=5 820 RANDOMIZE 830 IF RND<.75 THEN 850 840 Y=6 850 GOTO 990 860 Y=7 870 RANDOMIZE 880 IF RND>.35 THEN 900 890 Y=8 900 RANDOMIZE 910 IF RND<.75 THEN 930 920 Y=9 930 GOTO 990 940 PRINT " WELL. THAT'S ALL" 950 PRINT " HOPE YOU LIKED IT!!" 960 PRINT "RUN IT AGAIN AND HEAR FIVE " 970 PRINT " MORE SONGS." 980 END 990 FOR I=1 TO 9 STEP 3 1000 CALL SOUND(P,X(Y,I),2,X(Y,I+1),2) 1010 CALL SOUND(P,X(Y,I),30,X(Y,I+2),2) 1020 NEXT I 1030 GOTO 570 1040 CALL SOUND(1800,196,2,494,2,784,2) 1050 FOR T=1 TO 800 1060 NEXT T 1070 KOL=INT(RND*+8) 1080 CALL SCREEN(KOL) 1090 GOTO 570 Edited October 15, 2022 by oddemann Fixed bug! 1 Quote Link to comment Share on other sites More sharing options...
+Lee Stewart Posted May 9, 2019 Share Posted May 9, 2019 Again PDF above! - OBS!!! Error in line 1000!!! Or I did something wrong! . . . You have four lines labeled “500”. The last one replaces the others. 500 DATA 196,659,587,262,523,523,330,523,262 510 P=250 500 DATA 1,3,6,2,1,4,6,2,3,4,1,5,1,4,6,7,1,4,6,2,1,3,6,9 500 DATA 1,1,4,5,1,4,6,2,3,4,1,5,1,4,1,5,1,4,6,9 500 DATA 1,4,6,2,3,6,1,5,1,4,6,7,3,4,6,2,1,4,3,7,1,4,6,9 should be 500 DATA 196,659,587,262,523,523,330,523,262 510 P=250 520 DATA 1,3,6,2,1,4,6,2,3,4,1,5,1,4,6,7,1,4,6,2,1,3,6,9 530 DATA 1,1,4,5,1,4,6,2,3,4,1,5,1,4,1,5,1,4,6,9 540 DATA 1,4,6,2,3,6,1,5,1,4,6,7,3,4,6,2,1,4,3,7,1,4,6,9 ...lee 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 9, 2019 Author Share Posted May 9, 2019 ****SPRITE DEMO**** (Again same PDF) 100 CALL CLEAR 110 PRINT TAB(5):"****SPRITE DEMO****" 120 PRINT :: PRINT "DESIGNED TO ACCOMPANY" 130 PRINT """A BEGINNER'S GUIDE TO SPRITES IN TI EXTENDED BASIC""" 170 FOR D=1 TO 1000 :: NEXT D 180 CALL CLEAR 190 PRINT "THIS DEMONSTRATION FOLLOWS THE SEQUENCE OF THE ARTICLE." 200 PRINT :: PRINT "THE PROGRAM STEPS USED ARE THE SAME AS THOSE USED IN THE ARTICLE." 210 PRINT :: PRINT "AT THE END OF EACH DEMO. A TONE WILL SOUND." 220 PRINT :: PRINT "THEN PRESS LETTER Q TO CON- TINUE WITH THE NEXT DEMO." 230 FOR D=1 TO 1000 :: NEXT D 240 CALL CLEAR 250 A$="010204020123568D" 260 B$="8D56230102040201" 270 C$="8040204080C46AB1" 280 D$="B16AC48040204080" 290 CALL CHAR(96,A$&B$&C$&D$) 300 CALL CHAR(90,"1818183C3C3C66C3") 310 CALL SCREEN(15) 320 CALL SPRITE(#1,96,7,95,75) 330 CALL SPRITE(#2,90,2,170,125) 335 FOR D=1 TO 500 :: NEXT D 340 GOSUB 2500 350 CALL MAGNIFY(2) 360 DISPLAY AT(3,3):"MAG. FACTOR 2" 370 FOR D=1 TO 500 :: NEXT D 380 CALL MAGNIFY(3) 390 DISPLAY AT(3,3)ERASE ALL:"MAG. FACTOR 3" 400 FOR D=1 TO 500 :: NEXT D 410 CALL MAGNIFY(4) 420 DISPLAY AT(3,3)ERASE ALL:"MAG. FACTOR 4" 430 FOR D=1 TO 500 :: NEXT D 440 CALL CLEAR 450 CALL CHAR(130,"1818183C3C3C66C3") 460 GOSUB 3000 465 DISPLAY AT(2,3):"MAG. FACTOR 3" 467 DISPLAY AT(3,3):"UNWANTED CHARACTERS NOW RE- MOVED WHEN ""FREE"" CHAR- ACTER CODE USED" 468 FOR D=1 TO 500 :: NEXT D 470 FOR D=1 TO 500 :: NEXT D 480 CALL MAGNIFY(4) 490 DISPLAY AT(3,3)ERASE ALL:"MAG. FACTOR 4" 500 FOR D=1 TO 500 :: NEXT D 510 CALL MAGNIFY(3) 520 DISPLAY ERASE ALL 530 GOSUB 2500 535 DISPLAY AT(2,3):"POSITION DEMO" 536 FOR D=1 TO 500 :: NEXT D 540 CALL POSITION(#1,DR1,DC1) 550 CALL POSITION(#2,DR2,DC2) 560 PRINT TAB(6);"ROW"," COL" 570 PRINT "#1: ";DR1,DC1 580 PRINT "#2: ":DR2,DC2 590 FOR D=1 TO 500 :: NEXT D 600 GOSUB 2500 610 CALL CLEAR 620 GOSUB 3000 625 DISPLAY AT(2,3):"CHARPAT DEMO" 626 FOR D=1 TO 300 :: NEXT D 630 CALL CHARPAT(130,CP2$):: PRINT CP2$ 640 FOR CC=96 TO 99 650 CALL CHARPAT (CC,CP1$) 660 PRINT CP1$ :: NEXT CC 670 FOR CC=42 TO 52 STEP 10 680 CALL CHARPAT(CC,CP$) 690 PRINT TAB(2);CHR$(CC);" ";CP$ :: NEXT CC 700 FOR D=1 TO 500 :: NEXT D 710 GOSUB 2500 720 CALL CLEAR 730 GOSUB 3000 735 DISPLAY AT(2,3):"DISTANCE DEMO" 736 FOR D=1 TO 300 :: NEXT D 740 CALL DISTANCE(#1,#2,X) 750 DST=SQR(X) 760 PRINT DST 770 CALL DISTANCE(#1,1,1,Y) 780 DIS=SQR(Y) 790 PRINT DIS 800 FOR D=1 TO 500 :: NEXT D 810 GOSUB 2500 820 CALL CLEAR 830 GOSUB 3000 835 DISPLAY AT(2,3):"LOCATE DEMO" 836 FOR D=1 TO 300 :: NEXT D 840 CALL LOCATE(#2,1,200) 850 FOR D=1 TO 500 :: NEXT D 860 CALL LOCATE(#2,16,16) 870 FOR D=1 TO 500 :: NEXT D 880 CALL LOCATE(#2,170,125) 890 FOR D=1 TO 500 :: NEXT D 900 GOSUB 2500 905 DISPLAY AT(2,3)ERASE ALL:"PATTERN DEMO" 906 FOR D=1 TO 300 :: NEXT D 910 CALL CHAR(140,"80C0783F3F78C080") 920 CALL PATTERN(#2,140) 930 FOR D=1 TO 500 :: NEXT D 940 CALL PATTERN(#2,130) 950 GOSUB 2500 960 GOSUB 3500 965 DISPLAY AT(2,3)ERASE ALL:"MOTION DEMO" 966 FOR D=1 TO 300 :: NEXT D 967 DISPLAY ERASE ALL 970 FOR D=1 TO 3000 :: NEXT D 980 GOSUB 2500 990 GOSUB 3500 995 DISPLAY AT(2,3)ERASE ALL:"DELSPRITE DEMO" 996 FOR D=1 TO 300 :: NEXT D 997 DISPLAY ERASE ALL 1000 FOR D=1 TO 2200 :: NEXT D 1010 CALL DELSPRITE(#2) 1020 FOR D=1 TO 1000 :: NEXT D 1030 GOSUB 2500 1040 CALL CLEAR 1045 CALL SPRITE(#2,130,2,170,125) 1050 GOSUB 4000 1055 DISPLAY AT(2,3):"USE OF CALL KEY TO INITIATE MOTION" 1056 FOR D=1 TO 300 :: NEXT D 1057 DISPLAY ERASE ALL 1060 FOR D=1 TO 2000 :: NEXT D 1080 GOSUB 2500 1090 GOSUB 3500 1095 DISPLAY AT(2,3)ERASE ALL:"COINC DEMO" 1096 FOR D=1 TO 300 :: NEXT D 1100 CALL COINC(#1,#2,15,C1) 1110 CALL COINC(#2,1,125,1,C2) 1120 PRINT C1 1130 IF C1=-1 THEN 1150 ELSE 1140 1140 IF C2=-1 THEN 1200 ELSE 1100 1150 CALL SCREEN(11) 1160 CALL SOUND(100,262,2) 1170 FOR D=1 TO 200 :: NEXT D 1180 CALL SCREEN(15) 1190 GOTO 1100 1200 CALL SCREEN(4) 1210 CALL SOUND(100,523,2) 1220 FOR D=1 TO 200 :: NEXT D 1230 CALL SCREEN(15) 1240 GOTO 1100 1250 STOP 2500 DISPLAY BEEP 2510 CALL KEY(0,K,S) 2520 IF S=0 THEN 2510 2530 IF K=81 THEN 2540 ELSE 2510 2540 RETURN 3000 CALL SCREEN(15) 3010 CALL SPRITE(#1,96,7,95,75) 3020 CALL SPRITE(#2,130,2,170,125) 3030 CALL MAGNIFY(3) 3040 RETURN 3500 CALL SPRITE(#1,96,7,95,75,50,-50) 3510 CALL MOTION(#2,-5,0) 3520 RETURN 3530 STOP 4000 DISPLAY AT(3,3):"PRESS SPACE BAR TO START MOTION OF SPACESHIP SPRITE" 4005 FOR D=1 TO 200 :: NEXT D 4006 DISPLAY ERASE ALL 4010 CALL KEY(0,K,S) 4020 IF S=0 THEN 4010 4030 IF K=32 THEN 4040 ELSE 4010 4040 CALL MOTION(#2,-5,0) 4050 RETURN 2 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 9, 2019 Author Share Posted May 9, 2019 You have four lines labeled “500”. The last one replaces the others. 500 DATA 196,659,587,262,523,523,330,523,262 510 P=250 500 DATA 1,3,6,2,1,4,6,2,3,4,1,5,1,4,6,7,1,4,6,2,1,3,6,9 500 DATA 1,1,4,5,1,4,6,2,3,4,1,5,1,4,1,5,1,4,6,9 500 DATA 1,4,6,2,3,6,1,5,1,4,6,7,3,4,6,2,1,4,3,7,1,4,6,9 should be 500 DATA 196,659,587,262,523,523,330,523,262 510 P=250 520 DATA 1,3,6,2,1,4,6,2,3,4,1,5,1,4,6,7,1,4,6,2,1,3,6,9 530 DATA 1,1,4,5,1,4,6,2,3,4,1,5,1,4,1,5,1,4,6,9 540 DATA 1,4,6,2,3,6,1,5,1,4,6,7,3,4,6,2,1,4,3,7,1,4,6,9 ...lee "Programmers blindness" I remember, the PDF would not copy correct and I copy same line to not have to write "DATA" again and was then "mind blind" to that. Thx, Lee! 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 9, 2019 Author Share Posted May 9, 2019 (edited) Sprite Editor - Something wrong with CALL KEY i think!!! Larry Long Here's a way to get maximum use of sprites on the TI-99/4A—and a program that generates listings for your sprite creations. Requires Extended BASIC. A very powerful yet often unused feature of the TI-99/4A is its ability to display and control sprites. With the 99/4A and the Extended BASIC Module, it's possible to generate 28 sprites for display and independent simultaneous movement. Program 1 should convince any doubters that this can be done. Although a lot of colored letters floating around the screen are a bit pointless, if we can modify and control the sprites, we will have a most useful feature. Sprites can be designed by drawing on a piece of graph paper and then converting the on/off pixels to a hexadecimal number. If the two largest sizes of sprites are used, the hexadecimal number describing the shape of the sprite would be 64 characters long (for a more extensive discussion on sprite creation see "A Beginner's Guide to Sprites" elsewhere in this book). A solution is a sprite editor that will allow us to draw the pattern we want on the screen and then have the com puter create the program we need to make that sprite pattern. Program 2 will do exactly that, and more. It will allow us to edit the sprite pattern. Then, when we press the L key, it will display a complete listing that would, if copied on paper and then entered into the computer, provide a sprite and the necessary routine to control its movement. Your Options When you run the program, the first display screen will be a design grid with a box-shaped cursor. The area under the cursor will initially be white (signifying an off pixel). Press 1 to change the color beneath the cursor to black (representing an on pixel) or to move the cursor about the grid using the arrow keys. To turn off a particular pixel, press 0 and the back ground color will be returned to white. When you have ""*] completed your design, press the P key to see it displayed as a sprite. At this point, you are given several options. You can magnify your newly constructed sprite (M key), change its color. (C key), change its background color (B key), or set it in motion (E, S, D, X keys). If you are not pleased with the sprite's shape, you can modify it by striking the T key or (if the changesrequired are quite drastic) simply press the A key to start with a fresh grid. On the other hand, if you are satisfied with your sprite and its color and directional parameters, press the L key to create the BASIC statements needed to achieve these effects. If using the sprite editor is your only concern, then skip the rest of this article and go straight to Program 2 and enjoy this easy access to sprites. How the Editor Works To understand what makes the editor work, let's take a general overview of the program: Lines 100-260 Set up screen display. 270-460 The main loop of the designing portion of the program. 470-680 Evaluate the design, put its values in an array, read the values in the array, convert them to hexadecimal numbers, and then build a 64-character string to describe the sprite pattern. 690-770 Put the sprite on the screen and display new program instructions. 780-930 Main loop of the implementation portion of the program. 940-980 Change size of sprite. 1000-1150 Display a listing of the sprite program. 1160-1220 Change the color of the sprite and screen. A cursor is needed to indicate where you are located on the design grid. I chose to use a sprite (line 220) because I could move it around freely without disturbing the display under it. Repositioning the cursor is accomplished in line 380 with a CALL LOCATE. The arrow keys reposition the cursor, and the ENTER key changes the area under the cursor. What makes "Sprite Editor" so valuable is its ability to generate the hexadecimal pattern for the sprite. The loop from line 500 through line 560 determines the character in each position of the design grid and stores that value in the array B (R,C). Line 570 provides a string with all of the possible hexadecimal digits placed in ascending order. Line 580 sets M$ to null. The loop from line 590 to line 630 evaluates the array elements and converts each row in the left half of the design grid to a pair of hexadecimal digits and concatenates them to M$. Line 620 is probably the most significant line in ' this loop, as it provides the hexadecimal numbers. It causes the computer to look at a particular digit (element) in HEX$ determined by the values calculated for HIGH and LOW. Lines 630-680 perform the same operation as 590-630, only for the right half of the design grid. Line 690 assigns the hexadecimal numbers to ASCII characters 104, 105, 106, and 107. It is necessary to specify only the first character number in the CALL CHAR statement. When this feature is used, it is required that you start with a character that is evenly divisible by 4. Line 730 actually displays the sprite. Lines 740-770 provide instructions for the implementation portion of the program. Lines 780-830 check for specific key presses and provide appropriate branching to list the program; end the program; start from the beginning; change the background color; modify the existing sprite; change sprite size; or change sprite color. Lines 840-920 check for arrow key presses and then increment or decrement sprite speed. Lines 940-980 change sprite size. Lines 1000-1150 display a program listing that would generate a sprite like the one designed by the Sprite Editor. One problem with listing the program is displaying the quote character. The computer interprets it to mean that you want to end the PRINT statement. The solution is to redefine an unused character (I chose the lowercase n) to look like the quote character. Finally, lines 1160-1220 allow you to change the color of the sprite and screen. Spoiler 100 CALL MAGNIFY(2):: FOR X=1 TO 28 :: CALL SPRITE(#X,64+X,X/2,96,128,INT(RND*100)-50,INT(RND*100)-50):: NEXT X :: GOTO 100 100 REM SPRITE EDITOR 110 DIM B(16,16):: SC=8 130 C1=7 140 CALL CHAR(100,"") 150 CALL CHAR(101,"FFFFFFFFFFFFFFFF") 160 CALL CHAR(102,"FFFFC3C3C3C3FFFF") 170 CALL COLOR(9,2,16) 180 CALL CLEAR 190 DISPLAY AT(1,10):"SPRITE EDITOR" 200 FOR R=1 TO 16 :: CALL HCHAR(4+R,2,100,16):: NEXT R 210 CALL MAGNIFY(1) 212 IF K=84 THEN GOTO 217 215 CALL SCREEN(8) 217 CALL DELSPRITE(ALL) 220 CALL SPRITE(#28,102,14,32,8) 225 CALL HCHAR(21,1,32,31):: CALL HCHAR(22,1,32,31) 230 DISPLAY AT (22,2):"E=UP X=DOWN S=LEFT D=RIGHT" 240 DISPLAY AT(23,2):"PRESS 1 - PIXEL ON ,0 - OFF" 250 DISPLAY AT(24,2):"PRESS P TO DISPLAY SPRITE" 260 R=1 :: C=1 265 KHAR=100 270 CALL KEY(0,K,S) 271 IF S=0 THEN 270 272 IF K=48 THEN KHAR=100 274 IF K=49 THEN KHAR=101 280 IF K=83 THEN C=C-1 :: GOTO 320 290 IF K=68 THEN C=C+1 :: GOTO 320 300 IF K=69 THEN R=R-1 :: GOTO 320 310 IF K=88 THEN R=R+1 :: GOTO 320 312 IF K=80 THEN 470 320 IF C<1 THEN C=16 330 IF C>16 THEN C=1 340 IF R<1 THEN R=16 350 IF R>16 THEN R=1 380 CALL LOCATE(#28,(8*R)+25,8*C+1) 420 CALL HCHAR(4+R,1+C,KHAR) 430 CALL SOUND(20,200,5) 460 GOTO 270 470 CALL DELSPRITE(ALL) 480 CALL HCHAR(21,1,32,128) 490 DISPLAY AT(22,2):"PLEASE WAIT WHILE I THINK." 500 FOR R=1 TO 16 510 FOR C=1 TO 16 520 CALL GCHAR(4+R, 1+C,GC) 530 GC=GC-100 540 B(R,C)=GC 550 NEXT C 560 NEXT R 570 HEX$="0123456789ABCDEF" 580 M$="" 590 FOR R=1 TO 16 600 LOW=B(R,5)*8+B(R,6)*4+B(R,7)*2+B(R,8)+1 610 HIGH=B(R,1)*8+B(R,2)*4+B(R,3)*2+B(R,4)+1 620 M$=M$&SEG$(HEX$,HIGH,1)&SEG$(HEX$,LOW,1) 630 NEXT R 640 FOR R=1 TO 16 650 LOW=B(R,13)*8+B(R,14)*4+B(R,15)*2+B(R,16)+1 660 HIGH=B(R,9)*8+B(R,10)*4+B(R,11)*2+B(R,12)+1 670 M$=M$&SEG$(HEX$,HIGH,1)&SEG$(HEX$,LOW,1) 680 NEXT R 690 CALL CHAR(104,M$) 700 CALL MAGNIFY(3) 710 MM=3 720 M=4 730 CALL SPRITE(#1,104,C1,50,170,0,0) 740 DISPLAY AT(21,2):"C COLOR M MAGNIFY T EDIT" 750 DISPLAY AT(22,2):"A ERASE Q QUIT B BACKGRD" 760 DISPLAY AT(23,2):"E=UP X=DOWN S=LEFT D=RIGHT" 770 DISPLAY AT(24,:"L LISTS PROGRAM" 780 CALL KEY(0,K,S) 790 IF K=76 THEN GOTO 1000 800 IF K=81 THEN GOTO 990 810 IF K=65 THEN GOTO 100 812 IF K=66 THEN GOSUB 1200 815 IF K=84 THEN GOTO 210 820 IF K=77 THEN GOTO 940 830 IF K=67 THEN GOTO 1160 840 IF K=83 THEN H=H-2 850 IF K=68 THEN H=H+2 860 IF K=69 THEN V=V-2 870 IF K=88 THEN V=V+2 880 IF V>120 THEN V=120 890 IF V<-120 THEN V=-120 900 IF H>120 THEN H=120 910 IF H<-120 THEN H=-120 920 CALL MOTION(#1,V,H) 930 GOTO 780 940 CALL MAGNIFY(M) 950 MM=M 960 IF M=3 THEN M=4 ELSE M=3 970 FOR D=1 TO 20 :: NEXT D 930 GOTO 780 990 STOP 1000 REM PROGRAM LISTER 1005 CALL SCREEN( 1010 CALL CHAR(110,"002424") 1020 CALL CLEAR 1030 PRINT " PROGRAM LISTING" 1035 CALL DELSPRITE(ALL) 1040 PRINT 1050 PRINT ">100 CALL CHAR(104,n";:: FOR W=1 TO 64 :: PRINT SEG$(M$,W,1) ;:: NEXT W :: PRINT "n)" 1055 PRINT ">105 CALL SCREEN(";SC;")" 1060 PRINT ">110 CALL MAGNIFY (";MM;")" 1070 PRINT ">120 CALL SPRITE(#1,104,";C1;",150,150,";V;",";H; ")" 1080 PRINT ">130 CALL KEY(0,K,S)" 1090 PRINT ">140 IF K=63 THEN H=H+2" 1100 PRINT ">150 IF K=83 THEN H=H-2" 1110 PRINT ">160 IF K=88 THEN V=V+2" 1120 PRINT ">170 IF K=69 THEN V=V-2" 1130 PRINT ">180 CALL MOTION(#1,V,H)" 1140 PRINT ">190 GOTO 130" 1150 PRINT :: PRINT :: PRINT :: PRINT :: PRINT 1155 DISPLAY AT(21,3):"A – ERASE Q- QUIT" 1156 CALL KEY(0,K,ST):: IF ST=0 THEN 1156 1157 IF K=81 THEN GOTO 990 1158 IF K=65 THEN GOTO 100 1159 GOTO 1156 1160 C1=C1+1 :: IF C1>16 THEN C1=2 1170 CALL COLOR (#1,C1) 1180 CALL KEY(0,K,S):: IF S THEN 1180 ELSE 780 1200 REM SCREEN COLOR CHANGE 1210 SC=SC+1 :: IF SC=17 THEN SC=2 1220 CALL SCREEN(SC) 1230 CALL KEY(0,K,S):: IF 3 THEN 1230 ELSE RETURN Edited October 15, 2022 by oddemann Still bug in it, the moving about dos not work! 2 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 9, 2019 Author Share Posted May 9, 2019 (edited) Simpel but very cool game! Runway 180 130 CALL CLEAR:: CALL SCREEN(5):: CALL COLOR(1,16,1,2,16,1,3,16,1,4,16,1,5,16,1,6,16,1,7,16,1,8,16,1) 140 DISPLAY AT(10,9):USING "RUNWAY 180" 150 FOR B=0 TO 30 STEP 2 :: CALL SOUND(-10, 110,30,110,30,2500,30,-8,B) :: CALL SOUND (-10,110,30,110,30,4000,30,-8,B):: NEXT B 160 CALL CLEAR:: DISPLAY AT(10,9):USING "PRESS" :: DISPLAY AT(12,9) :USING "I-FOR INSTRUCTIONS" 170 DISPLAY AT(14,14):USING "OR" :: DISPLAY AT(16,9):USING "G-FOR GAME" 180 CALL KEY(0,K,S):: IF S<>1 THEN 180 190 IF K=103 THEN 330 200 IF K=105 THEN 220 210 PRINT "ALPHA LOCK MUST BE OFF" :: PRINT:: PRINT "TRY AGAIN" :: FOR DELAY=1 TO 600 :: NEXT DELAY :: GOTO 160 220 CALL CLEAR :: PRINT "YOU ARE PILOTING A JET" :: PRINT :: PRINT "AIRCRAFT WHICH HAS BEEN " :: PRINT :: PRINT "CLEARED TO LAND ON": : 230 PRINT "RUNWAY 180." :: PRINT :: PRINT :: GOSUB 310 240 CALL CLEAR :: PRINT "USE YOUR JOYSTICK TO CONTROL" :: PRINT :: PRINT "SINK RATE AND AIRSPEED.":: 243 PRINT "JOYSTICK CONTROL-" :: PRINT 245 PRINT "LEFT: ACCELERATE" :: PRINT "RIGHT: BRAKE" :: PRINT "UP: DECREASE SINK RATE" 247 PRINT "DOWN: INCREASE SINK RATE" :: PRINT 250 PRINT "FIREBUTTON CONTROLS LANDING" :: PRINT :: PRINT "GEAR." :: PRINT :: PRINT :: GOSUB 310 :: CALL CLEAR 260 PRINT "TO RECOVER FROM A STALL" :: PRINT :: PRINT "INCREASE AIRSPEED ABOVE 60.":: PRINT :: PRINT "IF YOU CANNOT STOP BEFORE":: 270 PRINT "TOWER REACHES LEFT SIDE OF" :: PRINT :: PRINT "SCREEN, INCREASE AIRSPEED" :: PRINT 280 PRINT "TO 60 AND LIFT OFF FOR":: PRINT:: PRINT "ANOTHER PASS." :: PRINT :: PRINT :: GOSUB 310 :: CALL CLEAR 290 PRINT "YOU MAY HAVE FOUR PASSES":: PRINT :: PRINT "AT THE RUNWAY.....":: PRINT:: PRINT "BEWARE OF THE WIND SHIFTS!":: PRINT:: PRINT 300 PRINT "GOOD LUCK!!!!" :: PRINT :: PRINT:: PRINT :: PRINT :: GOSUB 310 :: GOTO 330 310 PRINT :: DISPLAY AT(24,1):USING "HIT ANY KEY TO CONTINUE" 320 CALL KEY(0,R8,S8) :: IF S8<>1 THEN 320 ELSE RETURN 330 A1=1 340 REM INITIALIZE —> 350 A=0:: B=-75:: LG=0:: CALL SCREEN(2) 360 CALL CLEAR :: CALL CHAR(33,"FFFFFFFFFFFFFFFF"):: CALL COLOR(1,8,1) 370 LC=0:: FOR Z=1 TO 16 :: CALL HCHAR(Z,1,33,32):: NEXT Z 380 CALL CHAR(42,"FFFFFFFFFFFFFFFF"):: CALL COLOR(2,13,1) 390 FOR Z=17 TO 20 :: CALL HCHAR(Z,1,42,32):: NEXT Z 400 RANDOMIZE 410 REM DEF CHAR 420 CALL CHAR(96,"00000000FFFFFFFFFFFFFFFF0000000000000000FFFFFFFFFFFFFFFF") 430 CALL CHAR(120,"0030181C3F1F0700") 440 CALL CHAR(121,"000000") 450 CALL CHAR(122,"00000000FCFF8000") 460 CALL CHAR(123,"00000000") 470 CALL CHAR(104,"00000000071F151F") 480 CALL CHAR(105,"0203030203030203") 490 CALL CHAR(106,"00008080E0F8A8F8") 500 CALL CHAR(107,"C040C0C040C0C0C0") 510 CALL CHAR(124,"0030181C3F1F07050000") 520 CALL CHAR(126,"00000000FCFF88840000") 530 CALL CHAR(125,"00000000") 540 CALL CHAR(127,"00000000") 550 CALL CHAR(128,"00000000021F3B00") 560 CALL CHAR(129,"000000000E56E300") 570 CALL CHAR(130,"00000000") 580 CALL CHAR(131,"00000000") 590 REM DRAW DISPLAY 600 CALL SPRITE(#1,96,2, 180, 1,0,B):: CALL COLOR(#1,16) 610 CALL SPRITE(#2,120,2,10,245,A,0):: CALL COLOR(#2,7) 620 CALL SPRITE(#3,104,2,110,250,0,-2) 630 CALL MAGNIFY(4) 640 FOR C5=1 TO 40 :: CALL LOCATE(#2,10,C5):: NEXT C5 :: GOSUB 870 650 REM MAIN LOOP 660 GOSUB 1120 :: GOSUB 890 670 IF J=0 THEN 690 680 CALL MOTION(#1,0,B,#2,A,0) 690 CALL COINC(#2,170,40,9,T) 700 CALL COINC(#3,110,1,4,DA) 710 CALL COINC(#2,240,40,9,E):: IF E=-1 THEN A=1 :: GOSUB 890 :: GOTO 680 720 IF DA=-1 THEN 1320 730 IF T<>-1 THEN 660 740 CALL MOTION(#2,0,0) 750 IF A>1 THEN GOSUB 920 :: GOSUB 960 GOTO 1660 760 IF LG=0 THEN 1660 770 GOTO 1760 780 REM UPDATE DISPLAY 790 IMAGE SINK RATE: ### 800 IMAGE RUNWAY ENDS ### YDS 810 IMAGE AIRSPEED: ### 820 IMAGE TOUCH DOWN 830 IMAGE SINK RATE TOO HIGH 840 IMAGE AIRSPEED TOO HIGH 850 IMAGE CRASH LANDING 860 IMAGE STALL WARNING! 870 DISPLAY AT(1,10)SIZE(20):USING "ATTEMPT NO. #":A1 880 RETURN 890 DISPLAY AT(3,10)SIZE(20):USING 790:A 900 DISPLAY AT(5,10)SIZE(20):USING 810:-B 910 RETURN 920 DISPLAY AT (7,5)SIZE(20) :USING 830 930 RETURN 940 DISPLAY AT(7,5)SIZE(20)BEEP:USING 840 950 DISPLAY AT(9,5)SIZE(20):USING "BOUNCE":: RETURN 960 DISPLAY AT(9,5)SIZE(20):USING 850 970 RETURN 980 CALL HCHAR(7,5,33,27):: DISPLAY AT(9,5)SIZE(20):USING 820 990 RETURN 1000 DISPLAY AT(9,5)SIZE(20):USING "WARNING" 1010 DISPLAY AT ( 11,5)SIZE(20) :USING 800:RE 1020 RETURN 1030 CALL HCHAR(7,5,33,27)::RETURN 1040 CALL HCHAR(9,5,33,27) ::RETURN 1050 CALL HCHAR(11,5,33,27):: RETURN 1060 DISPLAY AT(9,5)SIZE(20):USING "LIFT OFF" :: CALL HCHAR(11,5,33,27):: RETURN 1070 DISPLAY AT(3,10):"END OF RUNWAY ":: DISPLAY AT(5,10):USING "NEW APPROACH" :: DISPLAY AT(7, 10) :USING "NECESSARY" 1080 RETURN 1090 PRINT "THAT'S 5 PASSES AT THE" :: PRINT :: PRINT "RUNWAY. TURN IN YOUR" ::PRINT :: PRINT "PILOT LICENSE AND PUT": : 1100 PRINT "SOMEONE ELSE IN THE" :: PRINT :: PRINT "COCKPIT" :: PRINT :: RETURN 1110 DISPLAY AT(7,9)BEEP SIZE(20) :USING 860 :: RETURN 1120 REM JOYST/ LANDING GEAR 1130 CALL KEY(1,RV,ST):: IF RV=18 AND LG=0 THEN 1190 1140 CALL JOYST(1,X,Y):: IF X=0 AND Y=0 THEN GOSUB 1210 :: RETURN 1150 A=A-Y/4 :: B=B+X/4 1160 IF ABS(A)>127 THEN A=127*SGN(A) 1170 IF B>-50 THEN 1430 1180 J=1 :: RETURN 1190 CALL PATTERN(#2,124) 1200 A=A+3 :: B=B+20 :: LG=1 :: GOTO 1160 1210 REM COMPLICATIONS 1220 CP=INT(RND*16) 1230 IF CP=1 THEN B=B-1 1240 IF CP=6 THEN B=B+1 1250 IF CP=10 THEN A=A-1 1260 IF CP=15 THEN A=A+1 1270 J=0 :: RETURN 1280 IF ABS(A)>127 THEN A=127*SGN(A) 1290 GOTO 1310 1300 IF B<-127 THEN B=-127 1310 J=1 :: RETURN 1320 REM NEW APPROACH 1330 CALL MOTION(#2,0,0):: CALL POSITION(#2,R4,C4) 1340 IF A1>4 THEN 1400 1350 CALL DELSPRITE(#1,#3):: CALL CLEAR 1360 GOSUB 1070 1370 CALL PATTERN(#2,120) 1380 FOR X = C4 TO 255 :: CALL LOCATE(#2,INT(R4),X):: R4=R4-(R4/(255-C4)):: NEXT X 1390 A1=A1+1 :: GOTO 340 1400 CALL DELSPRITE(ALL):: CALL CLEAR 1410 GOSUB 1090 1420 FOR DELAY=1 TO 900 :: NEXT DELAY :: GOTO 1970 1430 REM STALL 1440 GOSUB 1110 1450 CALL MOTION(4»2,0,0) 1460 CALL POSITION(#2,SR,SC) 1470 CALL LOCATE(#2,SR,SC) 1480 CALL COINC(#2,170,40,2,T) 1490 CALL COINC(#3,110,1,2,DE):: IF DE=-1 THEN A1=A1+1:: GOSUB 870:: IF A1>4 THEN 1400 1500 IF T=-1 THEN 1660 1510 SR=SR+4 1520 CALL KEY(1,RV,ST) 1530 IF RV=18 AND LG=1 THEN 1610 1540 CALL JOYST(1,X,Y):: IF X=0 AND Y=0 THEN 1470 1550 B=B+X/4 1560 REM 1570 IF B<-60 THEN 1640 1580 CALL M0TI0N(#1,0,B) 1590 GOSUB 890 1600 GOTO 1470 1610 CALL PATTERN(#2,120) 1620 A=A-3 :: B=B-22 :: LG=0 1630 GOTO 1560 1640 GOSUB 1030 1650 RETURN 1660 REM CRASH 1670 CALL MOTION(#1,0,0,#2,0,0,#3,0,0,#4,0,0) 1680 CALL SOUND(1000,-7,0) 1690 FOR P=1 TO 10 1700 CALL SCREEN(2) 1710 CALL SCREEN(16):: NEXT P :: CALL SCREEN(2) 1720 CALL PATTERN(#2,128) 1730 FOR DELAY=1 TO 400 :: NEXT DELAY 1740 CALL DELSPRITE(ALL) 1750 GOTO 1970 1760 REM TOUCHDOWN/BRAKE/T&G 1770 GOSUB 980 :: IF B<-53 THEN 1940 1780 CALL JOYST(1,X,Y) :: B=B+X/2 1790 IF B>-1 THEN 1880 1800 CALL MOTION(#1,0,B) 1810 CALL COINC(#3,110,1,4,DA) 1820 IF DA=-1 THEN RE=0 :: GOSUB 1010 :: GOTO 1660 1830 CALL DISTANCE(#3,110,1,RQ) 1840 RE=INT(SQR(RQ)):: GOSUB 1000 :: GOSUB 900 1850 CALL KEY(1,RV,ST):: IF RV=18 AND B<-60 THEN GOSUB 1060 :: A=A-2 :: GOTO 1870 1860 GOTO 1780 1870 CALL MOTION(#2,A,0):: FOR DELAY=1 TO 200 :: NEXT DELAY :: GOTO 650 1880 REM SCORING 1890 CALL MOTION(#1,0,0,#2,0,0 ,#3,0,0,#4,0,0) 1895 FOR DELAY=1 TO 800 :: NEXT DELAY 1900 CALL DELSPRITE(ALL):: CALL CLEAR 1910 PRINT "CONGRATULATIONS !": : 1920 PRINT "YOUR SCORE IS : "; (RE/A1)*10:: 1930 GOTO 1990 1940 A=A-2 :: CALL MOTION(#2,A,0) :: GOSUB 940 1950 FOR DELAY=1 TO 20 :: NEXT DELAY 1960 A=A+2 :: GOSUB 1030 :: GOSUB 1040 :: GOTO 650 1970 REM PLAY AGAIN 1980 CALL CLEAR 1990 PRINT "PLAY AGAIN (Y/N)?" 2000 CALL KEY(2,RV,SV) 2010 IF SV=0 THEN 2000 2020 IF RV=15 THEN 2050 2030 IF RV=18 THEN 330 2040 GOTO 1990 2050 END Edited May 9, 2019 by oddemann 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 10, 2019 Author Share Posted May 10, 2019 (edited) Worm of Bemer - COOL! Same PDF as above! Stephen D. Fultz TI Translation by Patrick Parrish Nerm the worm is lost in Bemer Castle and needs your help to get home. You must guide him through 11 rooms and help him find magic mushrooms to eat along the way. The journey is a navigator's nightmare, because you never know where the next mushroom will grow, and if Nerm hits a wall or gets trapped by his tail, he loses one of his lives. "Worm of Bemer" is a fast-paced arcade game in which Nerm the Worm travels through rooms eating magic mushrooms. Nerm is lost in Bemer Castle and wants to return home. Guide Nerm to a mushroom using the keyboard arrow keys (E, S, D, and X) so he can keep up his strength for the journey. After eating five mushrooms in a room, Nerm can exit to the next room. You must guide Nerm through 11 rooms before he finds his home. You start out with four lives. If you touch anything besides a mushroom you will lose a life. At the top of the screen you will see the current score, what room Nerm is in, how many mushrooms Nerm must eat to open the exits, and how many lives Nerm has left, includ ing the current life. You get 100 points, plus bonus points, for every mushroom you eat. Nerm gets a bonus life after completing the first two rooms and another for every third room thereafter. Adding More Features You can learn a lot about programming and games by modifying the action and settings in Worm of Bemer. Some features you might add include a routine to save the high score to disk, adding more players, or having Nerm go to a different room ' depending on which exit he takes. Simpler enhancements would be changing the number of mushrooms that Nerm must eat or changing his speed. Worm of Bemer Spoiler 3 DIM NN(29),RANK$(12) 5 GOSUB 11000 10 GOTO 5000 20 FOR I=1 TO LEN(H$) 30 CALL HCHAR(ROW,COL+I,ASC(SEG$(H$,I,1))) 35 NEXT I 40 RETURN 100 CALL KEY(0,K,ST) 105 IF (K<>68)+(OD=2)THEN 110 106 DX=1 107 DY=0 108 DI=1 110 IF (K<>83)+(OD=1) THEN 115 111 DX=-1 112 DY=0 113 DI=2 115 IF (K<>69)+(OD=3) THEN 120 116 DY=-1 117 DX=0 118 DI=4 120 IF (K<>88)+(OD=4) THEN 140 125 DY=1 130 DX=0 135 DI=3 140 CALL HCHAR(YA,XA,136) 145 OD=DI 150 XA=XA+DX 152 YA=YA+DY 154 L=LEN(XA$) 156 XA$=XA$&CHR$(XA) 158 YA$=YA$&CHR$(YA) 160 CALL GCHAR(YA,XA,Z) 162 IF Z<>32 THEN 200 164 CALL HCHAR(YA,XA,128) 166 CALL SOUND(1,622,2) 168 IF L<WO THEN 100 170 CALL HCHAR(ASC(YA$),ASC(XA$),32) 172 LL=LEN(XA$)-1 174 XA$=SEG$(XA$,2,LL) 176 YA$=SEG$(YA$,2,LL) 180 GOTO 100 200 CALL SOUND(100,311,2) 201 CALL HCHAR(YA,XA,128) 203 GOSUB 6600 205 IF Z<>MUSH THEN 260 210 WO=WO+15+2*LO 212 IF WO<185 THEN 215 214 WO=185 215 RANDOMIZE 216 XX=RND*28+3 218 X=RND*19+4 220 CALL GCHAR(X,XX,H1) 222 IF H1<>32 THEN 216 224 SC=SC+100+LO*7 228 HI=HI-1 230 GOSUB 6600 232 IF HI>0 THEN 245 234 CALL HCHAR(3,17,104) 236 CALL HCHAR(13,2,104) 238 CALL HCHAR(13,31,104) 240 CALL HCHAR(23,17,104) 241 FOR I=3 TO 30 STEP 3 242 CALL SOUND(100,1900,I) 243 NEXT I 244 GOTO 100 245 CALL HCHAR(X,XX,MUSH) 250 GOTO 100 260 IF Z=104 THEN 270 261 IF LI=1 THEN 7500 264 GOSUB 7500 266 GOTO 290 270 CALL HCHAR(YA,XA,136) 272 GOSUB 7000 275 FOR DE=110 TO 880 STEP 32 277 PRINT 279 CALL SOUND(1,DE,2) 280 CALL SOUND(-1,DE,2) 281 NEXT DE 282 LO=LO+1 283 IF LO=12 THEN 1200 284 WO=5 285 L1=L1+1 286 IF LO>EX THEN 9100 287 CALL COLOR(14,L1,1) 288 CALL CLEAR 289 GOSUB 1300 290 GOSUB 6600 300 ON LO GOTO 5080,400,500,550,600,700,800,450,550,1000,1100,1200 399 GOTO 5080 400 REM SECOND SCREEN 410 CALL HCHAR(13,5,120,24) 420 GOTO 5080 449 REM SCREEN 450 CALL VCHAR(7,15,120,16) 455 CALL HCHAR(9,6,120,22) 460 GOTO 5080 499 REM FOURTH SCREEN 500 CALL HCHAR(6,5,120,24) 505 CALL HCHAR(20,5,120,24) 510 GOTO 5080 549 REM FIFTH SCREEN 550 CALL HCHAR(7,6,120,22) 555 CALL VCHAR(8,15,120,16) 560 GOTO 5080 599 REM FRAME 6 600 CALL HCHAR(12,3,120,13) 610 CALL HCHAR(12,19,120,12) 620 GOTO 5080 699 REM FRAME 7 700 FOR I=8 TO 18 710 CALL HCHAR(I,7,120,7) 715 CALL HCHAR(I,18,120, 720 NEXT I 725 GOTO 5080 799 REM FRAME 8 800 CALL HCHAR(8,3,120,13) 805 CALL HCHAR(14,12,120,19) 810 CALL HCHAR(18,3,120,13) 815 GOTO 5080 999 REM FRAME 9 1000 GOSUB 1400 1015 FOR T=5 TO 21 1020 CALL HCHAR(T,4,32,16) 1025 NEXT T 1030 GOTO 5080 1100 GOSUB 1400 1110 FOR T=5 TO 21 1115 CALL HCHAR(T,4,32,20) 1120 NEXT T 1125 GOTO 400 1199 REM YOU WIN!! 1200 CALL CLEAR 1205 CALL SCREEN(3) 1206 FOR I=4 TO 8 1207 CALL COLOR(I,2,1) 1208 NEXT I 1210 PRINT TAB(9);"NERM'S HOME!" 1220 PRINT 1230 PRINT 1240 PRINT TAB(10);"THANK YOU!" 1250 FOR T=1 TO 9 1260 PRINT 1270 NEXT T 1275 FOR T=1 TO 3 1280 FOR I=110 TO 880 STEP 30 1283 CALL SOUND(1,I,2) 1284 CALL SOUND(-1,I,2) 1285 NEXT I 1286 FOR I=880 TO 110 STEP -30 1287 CALL SOUND(1,1,2) 1288 CALL SOUND(-1,I,2) 1289 NEXT I 1290 NEXT T 1291 CALL SCREEN(2) 1293 GOTO 7700 1300 CALL CLEAR 1305 PRINT "SCORE :";TAB(20);"ROOM :" 1310 PRINT "MUSHROOMS :";TAB(20);"LIVES :" 1320 FOR T=1 TO 21 1330 PRINT 1340 NEXT T 1350 RETURN 1400 FOR T=5 TO 21 1410 CALL HCHAR(T,4,120,26) 1420 NEXT T 1430 RETURN 4999 REM UP THE GAME 5000 GOSUB 10000 5005 MUSH=112 5010 LI=4 5015 SC=0 5020 LO=1 5035 HI=5 5040 WO=5 5045 EX=2 5050 L1=3 5055 GOSUB 5500 5060 CALL CLEAR 5065 CALL SCREEN(2) 5066 FOR I=3 TO 8 5067 CALL COLOR(I,16,1) 5068 NEXT I 5070 GOSUB 1300 5075 GOSUB 6600 5080 XA$="" 5081 YA$="" 5085 XA=17 5086 YA=18 5091 DX=0 5093 DY=-1 5103 IF HK6 THEN 5107 5105 HI=5 5107 IF HI>-1 THEN 5110 5109 HI=0 5110 DI=4 5115 FOR I=2 TO 31 STEP 29 5120 CALL VCHAR(3,I,120,21) 5125 NEXT I 5130 FOR I=3 TO 23 STEP 20 5135 CALL HCHAR(I,3,120,28) 5140 NEXT I 5145 CALL HCHAR(24,3,137,28) 5150 IF HI>0 THEN 5174 5155 CALL HCHAR(3,17,104) 5160 CALL HCHAR(12,2,104) 5165 CALL HCHAR(12,31,104) 5167 CALL HCHAR(23,17,104) 5171 GOTO 150 5174 RANDOMIZE 5175 XX=RND*28+3 5178 X=RND*19+4 5180 CALL GCHAR(X,XX,HI) 5185 IF HI<>32 THEN 5174 5190 CALL HCHAR(X,XX,MUSH) 5200 GOTO 150 5500 CALL CLEAR 5505 PRINT TAB(10);"GET READY!" 5510 FOR T=1 TO 12 5515 PRINT 5520 NEXT T 5525 FOR I=1 TO 14 5530 CALL SOUND(100,NN(I),2) 5535 NEXT I 5540 RETURN 6599 REM PRINT SCORE 6600 H$=STR$(SC) 6603 ROW=1 6604 COL=10 6605 GOSUB 20 6607 H$=STR$(LO) 6608 COL=28 6609 GOSUB 20 6610 H$=STR$(HI) 6611 ROW=2 6620 COL=14 6625 GOSUB 20 6630 H$=STR$(LI) 6635 COL=29 6640 GOSUB 20 6650 RETURN 6999 REM NERM LEAVES 7000 SP=SP-5 7005 GOSUB 6600 7010 HI=5 7015 L=LEN(XA$) 7020 FOR I=1 TO L 7025 CALL SOUND(2,110+1*2,2) 7030 CALL HCHAR(ASC(YA$),ASC(XA$) 7035 LL=LEN(XA$)-1 7040 XA$=SEG$(XA$,2,LL) 7045 YA$=SEG$(YA$,2,LL) 7050 NEXT I 7060 RETURN 7499 REM OOP!! 7500 CALL CLEAR 7505 PRINT TAB(13);"OOPS" 7510 FOR I=1 TO 12 7515 PRINT 7520 NEXT I 7525 LI=LI-1 7547 FOR I=14 TO 24 7549 CALL SOUND(10,I*40,2) 7551 NEXT I 7553 FOR I=1 TO 30 7555 NEXT I 7560 IF LI<1 THEN 7700 7575 GOSUB 1300 7600 RETURN 7699 REM THE GAME ENDS 7700 CALL CLEAR 7704 FOR I=3 TO 8 7705 CALL COLOR(I,16,1) 7706 NEXT I 7710 IF HS>SC THEN 7750 7720 HS=SC 7721 FOR I=1 TO 5 7722 PRINT 7723 NEXT I 7725 PRINT TAB(;"NEW HIGH SCORE" 7728 FOR T=110 TO 1760 STEP 50 7729 CALL SOUND(2,T,2) 7730 NEXT T 7740 FOR I=1 TO 5 7743 PRINT 7745 NEXT I 7750 PRINT TAB(7);"YOUR SCORE: ";SC 7755 PRINT 7760 PRINT TAB(7) ;"HIGH SCORE: ";HS 7770 FOR I=1 TO 3 7775 PRINT 7780 NEXT I 7785 PRINT TAB(5);"YOUR NEW RANK IS :" 7790 PRINT 7795 PRINT TAB(9);RANK$(LO) 7796 FOR I=15 TO 29 7797 CALL SOUND(100,NN(I),2) 7798 NEXT I 7800 PRINT 7805 PRINT 7806 PRINT 7810 PRINT "(C TO CONTINUE Q TO QUIT)" 7815 FOR T=1 TO 4 7816 PRINT 7817 NEXT T 7820 CALL KEY(0,K,ST) 7830 IF ST=0 THEN 7820 7840 IF (K<>67)*(K<>81)THEN 7820 7845 IF K=67 THEN 5000 7850 STOP 9099 REM EXTRA LIFE 9100 CALL CLEAR 9110 PRINT TAB(11);"BONUS LIFE" 9120 FOR I=1 TO 12 9125 PRINT 9130 NEXT I 9132 FOR I=1 TO 30 STEP 2 9134 CALL SOUND(100,1175,I) 9136 NEXT I 9140 EX=EX+3 9145 LI=LI+1 9150 GOTO 287 10000 CALL CLEAR 10001 FOR T=3 TO 8 10003 CALL COLOR(T,2,1) 10006 NEXT T 10010 CALL COLOR(14,3,1) 10015 CALL SCREEN(15) 10020 PRINT TAB(10);"WELCOME TO" 10021 FOR T=1 TO 4 10022 PRINT 10023 NEXT T 10025 PRINT TAB(8);"NERM OF BEMER" 10028 FOR T=1 TO 9 10030 PRINT 10032 NEXT T 10034 PRINT "USE E,S,D, & X KEYS TO MOVE" 10036 PRINT 10040 CALL HCHAR(21,3,136,4) 10042 CALL HCHAR(21,8,128) 10045 FOR I=1 TO 22 10047 CALL HCHAR(21,6+1,136) 10050 CALL HCHAR(21,7+I,128) 10052 CALL SOUND(10,622,2) 10055 CALL HCHAR(21,2+I,32) 10057 FOR T=1 TO 20 10058 NEXT T 10060 NEXT I 10065 FOR T=1 TO 100 10070 NEXT T 10075 RETURN 10999 REM REDEFINE CHARS 11000 FOR I=104 TO 136 STEP 8 11015 READ A$ 11020 CALL CHAR(I,A$) 11025 NEXT I 11030 DATA FFFFFFFFFFFFFFFF,187EFFFF18181818,FF81BDA5A5BD81FF 11032 DATA 8142243C7E5A3C18,387CFEFEFEFE7C38 11033 CALL COLOR(10,2,2) 11035 CALL COLOR(11,14,1) 11040 CALL COLOR(12,2,10) 11045 CALL COLOR(13,7,1) 11050 CALL CHAR(137,"FFFFFFFFFFFFFFFF") 11060 FOR I=1 TO 9 11065 READ RANK$(I) 11070 NEXT I 11075 FOR I=10 TO 12 11080 RANK$(I)="HALL OF FAME" 11085 NEXT I 11090 DATA ZERO,ROOKIE,NOVICE,AVERAGE 11092 DATA MASTER,GRAND MASTER,WIZARD,GRAND WIZARD 11094 DATA SUPER STAR 11100 FOR I=1 TO 29 11110 READ NN(I) 11120 NEXT I 11130 DATA 262,349,40000,349,392,40000,392,440,523,440,523,440,349,40000 11135 DATA 349,40000,40000,262,247,262,294,294,262,40000,40000,40000,330,330,349 11140 RETURN Edited October 15, 2022 by oddemann Fixed bug! 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 10, 2019 Share Posted May 10, 2019 I pressed caps-lock and it seems to work well. Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 10, 2019 Author Share Posted May 10, 2019 (edited) Duck Leader Douglas E. Smith and Douglas W. Smith This is no time to be feather-brained or daffy. There are hunters lurking in the maze of reeds ahead, and ifyou make a wrong turn, you and your friends will be duck soup. Two skill levels, ten difficulty ratings. This game will challenge your skill and memory. Your assignment, as the leader of a squadron of 30 ducks, is to direct them through a series of marsh mazes to the safety of a duck sanctuary. You must swim through five different mazes, each of which has invisible reed patches and hidden hunters. The reeds will send you back to the beginning of the maze. If you find a hunter, you will lose a duck. Save as many ducks as possible for a high score. Lose your squadron and it's all over. Favorite Duck After typing in the program, it's a good idea to list the program, check for errors, and then save a copy to tape or disk before running the program. When you start the game, the title graphics will appear, followed by several questions. 1. LEVEL=?(1=HELP/ 2=NO HELP) Enter 1 until you have gained confidence in your memory and problem-solving ability. With level 1 you may use the H key to quickly view the location of the reeds and hunters in the marsh (up to five times during one game). Level 2 will double your possible score, but you cannot use the H key for help. 2. DIFFICULTY=(1-10) I For your first game, enter 1. After some practice try the other difficulty ratings. Ratings 1-4 are easy, 5-7 are hard, and 8-10 are very challenging. The difficulty rating determines the complexity of the maze. 3. INSTRUCTIONS ? (Y/N) Enter Y to read the instructions before the game begins. This screen briefly describes the game and the functions of the appropriate keys used for the game. It also shows the graphic characters used for the reeds, hunters, and the marsh exit. 4. FIRST NAME OF THE LEAD DUCK? Type in your first name or the name of your favorite duck, and press ENTER. The game will then begin. If you entered Y for instructions, they will appear first. Hit the 1 key to begin play. At first the outline of the marsh appears, and then the positions of the reeds and hunters are indicated. You have 15 seconds to study the locations before the reeds and hunters become invisible. Successful Maneuvers The duck on the left side of the marsh represents your squadron. Move the duck by using the arrow keys (E, S, D, and X). You do not have to press ENTER or use the FCTN key. If you hit the sides of the marsh or the invisible reed, your ducks will bounce back to the starting position, but you do not lose any ducks. Meeting a hunter will result in gunfire and the loss of a duck, with the survivors returning to the start again. The positions of the reeds and hunters do not change until you reach the exit to the next marsh. Your goal is to maneuver your squadron to the right side of the marsh and out the exit to the next marsh. Once you have passed through the five marshes to safety, the program will congratulate you, show you the remaining ducks, and print your score. The highest possible score is 6000 and can be achieved only at level 2 with the difficulty rating 10. Nobody has achieved this score to date. The marsh border color changes to red if the squadron is depleted to ten or fewer ducks. Losing all the squadron will put you in Duck Soup, and give you a zero score. After the score is printed, the program will ask PLAY AGAIN? (Y/N). Enter Y to play again at the last selected level and difficulty. Enter N to choose a different level and difficulty. The Hkey may be used if you selected level 1. Pushing the H key while playing the game will give you a quick look at the marsh. Using this key does not change the position of the duck. You are limited to only five helps per game. Remember the highest score using level 1 will be half that of level 2. On occasion, the program will generate a maze which is impossible to cross. (Ducks don't always have it easy, do they?) Press the N key and you will move to a new marsh. The change in marshes will cost the squadron five ducks, so use the N key only if there is no way out. Some Noteworthy Routines The "Duck Leader" program employs several very useful TI BASIC routines. Creation of the maze is accomplished using the RND function to place the reeds and hunters (lines 620-670). The CALL GCHAR in line 800 tests the randomly determined position for characters already present on the marsh. Line 800 checks to see if an empty space is present and, if not, calls for a new set of coordinates to be generated. The CALL KEY routine (line 890) is used to move the duck through the marsh. Keys 68, 69, 83, and 88 determine the direction of the move. Once again the CALL GCHAR is used to test for an empty space. If found, the duck is printed in that position. If a reed or hunter is found, lines 1250-1260 execute the proper action. Several loops and counters pause the program and keep track of the ducks. Lines 690-720 give you time to view the maze before the characters become invisible. The H key sends the program to lines 1140-1220, making the maze visible. The ducks left are counted in lines 980 and 1310. The number of marshes traversed is counted in line 1380. The score is calculated in line 1550 and the ducks saved in line 1540. Changing the Difficulty You may wish to make the game less difficult by making one or more of the following changes: 1. Set the final value in the FOR-NEXT loop in line 690 to a higher value to increase the length of time you have to view the maze. 2. Increase the final value for Xin the FOR-NEXT loop beginning in line 1170 to give you a longer look when you use the H key. 3. Change the 5 in line 1150 to a greater number to increase the number of times you can use the H key. Duck Leader 120 RANDOMIZE 130 GOSUB 1720 140 CALL COLOR(13,2,1) 150 CALL COLOR(14,5,16) 160 CALL COLOR(11,13,1) 170 CALL COLOR(12,10,1) 180 CALL CLEAR 190 CALL SCREEN(12) 200 FOR X=1 TO 19 210 PRINT " DUCK LEADER DUCK LEADER" 220 NEXT X 230 PRINT 240 GOSUB 330 250 GOSUB 1420 260 INPUT "LEVEL=?(1=HELP/2=NO HELP)":LEVEL 270 INPUT "DIFFICULTY=?(1-10)":DIF 280 IF (DIF<1)+(DIF>10)THEN 270 290 INPUT "INSTRUCTIONS?(Y/N)":INS$ 300 INPUT "FIRST NAME OF LEAD DUCK?":NAME$ 310 IF INS$="Y" THEN 420 320 GOTO 520 330 FOR Y=12 TO 14 STEP 2 340 FOR X=1 TO 32 350 CALL HCHAR(Y,X,129) 360 CALL SOUND(25,-5,15) 370 CALL HCHAR(Y,X,128) 380 CALL HCHAR(Y,X,32) 390 NEXT X 400 NEXT Y 410 RETURN 420 CALL CLEAR 430 PRINT NAME$:: 440 PRINT "YOU ARE THE LEADER OF A": :"SQUADRON OF THIRTY DUCKS.": :"PADDLE THROUGH FIVE MARSHES": : 450 PRINT "TO SAFETY!!": :"USE ARROW KEYS TO MOVE": :"H-KEY FOR HELP(ONLY FIVE)": :"N-KEY=NEW MARSH(-5 DUCKS)": : 460 PRINT "WATCH OUT FOR REEDS..": :"AND HUNTERS!!": :"REEDS":"HUNTERS":"EXIT" 470 CALL HCHAR(21,12,112) 480 CALL HCHAR(22,12,113) 490 CALL HCHAR(23,12,137) 500 INPUT "ENTER 1 TO START":SRT 510 GOTO 520 520 REM MARSH 530 CALL SCREEN(15) 540 CALL CLEAR 550 PRINT TAB(10);"MARSH #";MARSH+1 560 CALL HCHAR(2,3,136,28) 570 CALL HCHAR(22,3,136,28) 580 CALL VCHAR(2,3,136,20) 590 CALL VCHAR(2,30,136,20) 600 CALL VCHAR(6,7,136,12) 610 CALL VCHAR(9,30,137,7) 620 FOR X=1 TO (DIF*5) 630 GOSUB 750 640 CALL HCHAR(ROW,COL,112) 650 GOSUB 750 660 CALL HCHAR(ROW,COL,113) 670 NEXT X 680 CALL HCHAR(12,5,128) 690 FOR X=1 TO 50 700 CALL COLOR(13,9,1) 710 CALL COLOR(13,2,1) 720 NEXT X 730 CALL SCREEN(13) 740 GOTO 830 750 REM RAN ROW+COL 760 ROW=INT(22*RND) 770 IF ROW<3 THEN 760 780 COL=INT(30*RND) 790 IF COL<4 THEN 780 800 CALL GCHAR(ROW,COL,GRC) 810 IF GRC<>32 THEN 760 820 RETURN 830 REM MOVE DUCK 840 R=12 850 C=5 860 CALL HCHAR(R,C,129) 870 CALL SOUND(25,-5,15) 880 CALL HCHAR(R,C,128) 890 CALL KEY(0,KEY,ST) 900 IF (KEY=68)+(KEY=69)+(KEY=72)+(KEY=78)+(KEY=83)+(KEY=88) THEN 910 ELSE 890 910 IF KEY=72 THEN 1140 920 IF KEY=78 THEN 980 930 CALL HCHAR(R,C,32) 940 IF KEY=68 THEN 1060 950 IF KEY=69 THEN 1080 960 IF KEY=83 THEN 1100 970 IF KEY=88 THEN 1120 980 DL=DL+5 990 IF DL>19 THEN 1000 ELSE 1040 1000 CALL COLOR(14,5,9) 1010 IF DL>=30 THEN 1020 ELSE 1040 1020 DL= 30 1030 GOTO 1470 1040 CALL SOUND(100,500,0) 1050 GOTO 520 1060 C=C+1 1070 GOTO 1230 1080 R=R-1 1090 GOTO 1230 1100 C=C-1 1110 GOTO 1230 1120 R=R+1 1130 GOTO 1230 1140 IF LEVEL<>1 THEN 890 1150 IF HELP=5 THEN 1210 1160 CALL SCREEN(15) 1170 FOR X=1 TO 50 1180 NEXT X 1190 HELP=HELP+1 1200 CALL SCREEN(13) 1210 CALL SOUND(5,1000,1) 1220 GOTO 890 1230 CALL GCHAR(R,C,GR) 1240 IF GR=32 THEN 860 1250 IF (GR=136)+(GR=112) THEN 1350 1260 IF GR=113 THEN 1280 1270 IF GR=137 THEN 1370 1280 CALL HCHAR(R,C,120) 1290 CALL SOUND(1,200,1) 1300 CALL HCHAR(R,C,113) 1310 DL=DL+1 1320 IF DL=20 THEN 1330 ELSE 1340 1330 CALL COLOR(14,5,9) 1340 IF DL=30 THEN 1470 ELSE 840 1350 CALL SOUND(50,-1,10) 1360 GOTO 840 1370 REM NEW MARSH 1380 MARSH=MARSH+1 1390 IF MARSH=5 THEN 1470 1400 GOSUB 1420 1410 GOTO 520 1420 FOR SC=4 TO 16 1430 CALL SCREEN(SC) 1440 CALL SOUND(1,3000,1) 1450 NEXT SC 1460 RETURN 1470 REM END OF GAME 1480 CALL CLEAR 1490 CN=INT( (28-LEN(NAME$))/2) 1500 PRINT TAB(CN);NAME$:: 1510 IF DL=30 THEN 1640 1520 GOSUB 1420 1530 GOSUB 1420 1540 DS=30-DL 1550 SCORE=LEVEL*DIF*DS*10 1560 PRINT "CONGRATULATIONS YOU SAVED ": :TAB(10):DS;"DUCKS!": :TAB(5);"F0R A SCOREOF ";SCORE 1570 FOR X=1 TO 12 1580 PRINT 1590 NEXT X 1600 CL=INT( (32-DS)/2) 1610 CALL HCHAR(6,CL,128,DS) 1620 GOSUB 330 1630 GOTO 1660 1640 REM DUCK SOUP 1650 PRINT "OH NO!! YOU'RE DUCK SOUP": :TAB (11)5"SCORE=0": : 1660 INPUT "PLAY AGAIN?(Y/N)":PLAY$ 1670 DL=0 1680 HELP=0 1690 MARSH=0 1700 CALL COLOR(14,5,16) 1710 IF PLAY$="Y" THEN 520 ELSE 1810 1720 REM CALL CHAR 1730 CALL CHAR(128,"00040B04FE7C8800") 1740 CALL CHAR(129,"00081608FE7C4400") 1750 CALL CHAR(136,"00AAAAAAAAAAAAAA") 1760 CALL CHAR(137,"00080C7E0C080000") 1770 CALL CHAR(112,"00AAAAAAAAAAAAAA") 1780 CALL CHAR(113,"0000609090677C64") 1790 CALL CHAR(120,"8142241818244281") 1800 RETURN 1810 END Edited May 10, 2019 by oddemann 2 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 10, 2019 Author Share Posted May 10, 2019 SPEECH WITH PRIMARY STRESS 100 REM STRESS POINT 11 0 CALL CLEAR 120 OPEN #1:"SPEECH",OUTPUT 130 PRINT "SPEECH WITH PRIMARY STRESS" 140 FOR I=1 TO 5 150 READ A$ 160 PRINT :: A$ 170 PRINT #1:A$ 180 NEXT I 190 DATA "HEAR THIS STRESS POINT" 200 DATA "^HEAR THIS STRESS POINT" 210 DATA "HEAR ^THIS STRESS POINT" 220 DATA "HEAR THIS ^STRESS POINT" 230 DATA "HEAR THIS STRESS ^POINT" 240 END 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 11, 2019 Author Share Posted May 11, 2019 TOWER OF HANOI 10 DIM A(10,5),V(30),W(15) 20 CALL CLEAR 30 CALL SCREEN( 40 PRINT TAB(10); "TOWER OF HANOI" 50 PRINT 60 PRINT 70 PRINT "AIM: MOVE ALL DISCS TO C" 80 PRINT 90 PRINT "RULE 1: ONLY MOVE ONE DISC EACH MOVE" 100 PRINT 110 PRINT "RULE 2: LARGE DISCS MUST NOT SIT ON SMALL DISCS" 120 PRINT 130 PRINT "PRESS ANY KEY TO START" 140 PRINT 150 CALL KEY(3,A1,B) 160 IF B=0 THEN 150 170 CALL CLEAR 180 PRINT 190 PRINT TAB(10); "TOWER OF HANOI" 200 PRINT 210 PRINT "HOW MANY DISCS DO YOU WANT?" 220 PRINT 230 PRINT "CHOOSE A NUMBER BETWEEN 2 AND 5" 240 PRINT 250 PRINT 260 CALL KEY(3,A1,B) 270 IF B=0 THEN 260 280 IF A1>49 THEN 300 290 GOTO 310 300 IF A1<54 THEN 360 310 PRINT 320 PRINT "YOU HAVE TYPED AN INVALID NUMBER" 330 FOR I=1 TO 500 340 NEXT I 350 GOTO 170 360 C=A1-48 370 FOR I=1 TO 21 380 READ V(I) 390 NEXT I 400 DATA 73,78,86,65,76,73,68,32,77,79,86,69 410 DATA 84,82,89,32,65,71,65,73,78 420 FOR I=1 TO 11 430 READ W(1) 440 NEXT I 450 DATA 84,89,80,69,32,65,32,77,79,86,69 460 FOR I=C TO 1 STEP -1 470 READ A(I,1) 480 A(I,2)=0 490 A(I,3)=0 500 NEXT I 510 DATA 1,2,3,4,5 520 H(1)=C 530 H(2)=0 540 H(3)=0 550 CALL CLEAR 560 CALL SCREEN(7) 570 PRINT 580 PRINT TAB(9); "TOWER OF HANOI" 590 PRINT 600 PRINT 610 PRINT "TARGET MOVES ";2^C-1 620 PRINT 630 PRINT "MOVES MADE ";M 640 FOR I=1 TO 17 650 PRINT 660 NEXT I 670 A$="FFFFFFFFFFFFFFFF" 680 B$="0000000000000000" 690 CALL CHAR(40,A$) 700 CALL CHAR(41,B$) 710 CALL CHAR(96,A$) 720 CALL COLOR(9,14,7) 730 CALL HCHAR(19,1,96,32) 740 CALL HCHAR(20,1,96,32) 750 CALL HCHAR(21,1,96,32) 760 CALL HCHAR(22,1,96,32) 770 CALL HCHAR(20,5,65) 780 CALL HCHAR(20,15,66) 790 CALL HCHAR(20,25,67) 800 GOSUB 5000 810 GOSUB 6000 820 IF H(I1)>0 THEN 940 830 FOR I=1 TO 12 840 CALL HCHAR(6,18+I,V(I)) 850 NEXT I 860 FOR I = 13 TO 21 870 CALL HCHAR(8,6+I,V(I)) 880 NEXT I 890 FOR I=1 TO 500 900 NEXT I 910 CALL HCHAR(6,19,41,12) 920 CALL HCHAR(8,19,41,9) 930 GOTO 800 940 IF H(I2)=0 THEN 960 950 IF A(H(I1),I1)>A(H(I2),I2) THEN 830 960 H(I2)=H(I2)+1 970 A(H(I2),I2)=A(H(I1),I1) 980 A(H(I1),I1)=0 990 H(I1)=H(I1)-1 1000 M=M+1 1010 M$=STR$(M) 1020 FOR I=1 TO LEN(M$) 1030 CALL HCHAR(6,14+I,ASC(SEG$(M$,I,1))) 1040 NEXT I 1050 GOSUB 5000 1060 IF H(3)<>C THEN 800 1070 PRINT "CONGRATULATIONS!!!!" 1080 GOTO 1080 5000 CALL COLOR(2,11,7) 5010 FOR P=1 TO 3 5020 FOR I=1 TO C 5030 R1=1+10*(P-1) 5040 R2=5-A(1,P) 5050 R3=2*A(I,P)-1 5060 R4=20-I*2aa 5070 IF A(I,P)=0 THEN 5110 5080 CALL HCHAR(R4,R1+R2,40,R3) 5090 CALL HCHAR(R4-1,R1+R2,40,R3) 5100 GOTO 5130 5110 CALL HCHAR(R4,R1,41,9) 5120 CALL HCHAR(R4-1,R1,41,9) 5130 NEXT I 5140 NEXT P 5150 RETURN 6000 CALL COLOR(5,2,7) 6010 CALL COLOR(6,2,7) 6020 CALL COLOR(7,2,7) 6030 CALL COLOR(8,2,7) 6040 FOR Y=1 TO 11 6050 CALL HCHAR(6,18+Y,W(Y)) 6060 NEXT Y 6070 CALL KEY(3,A1,B) 6080 IF B=0 THEN 6070 6090 FOR Y=1 TO 11 6100 CALL HCHAR(6,18+Y,41) 6110 NEXT Y 6120 CALL KEY(3,A2,B) 6130 IF B=0 THEN 6120 6140 I1=A1-64 6150 I2=A2-64 6160 RETURN 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted May 12, 2019 Share Posted May 12, 2019 A simple spinner sub-routine. Might be useful for BASIC game makers. The x,y coordinates could be variables of course. 100 CALL CLEAR 110 CALL CHAR(128,"1C02010101000000") 120 CALL CHAR(129,"000000010101021C") 130 CALL CHAR(130,"0000008080804038") 140 CALL CHAR(131,"3840808080000000") 150 PRINT "Spinner Demo" 160 PRINT "press a key to stop" 170 PRINT 180 GOSUB 9000 190 PRINT "Spinner stopped" 200 END 9000 CALL HCHAR(1,1,128) 9010 CALL HCHAR(1,1,129) 9020 CALL HCHAR(1,1,130) 9030 CALL HCHAR(1,1,131) 9040 CALL KEY(0,K,S) 9050 IF S=0 THEN 9000 9060 CALL HCHAR(1,1,32) 9070 RETURN 4 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 16, 2019 Author Share Posted May 16, 2019 (edited) GUNNERY - COPYRIGHT FREDERICK HOLTZ AND ASSOCIATES Spoiler 100 REM GUNNERY 110 REM COPYRIGHT FREDERICK HOLTZ AND ASSOCIATES 120 REM 5/1/83 130 REM PROGRAM RUNS IN TI- BASIC 140 CALL CLEAR 150 CALL CLEAR 160 PRINT "WELCOME TO THE GAME OF GUN-" 170 PRINT 180 PRINT "NERY. YOU ARE THE GUNNERY" 190 PRINT 200 PRINT "OFFICER AND ARE T0 FIRE ON" 210 PRINT 220 PRINT "A DISTANT TARGET. TO DO" 230 PRINT 240 PRINT "THIS, YOU MUST CONSIDER" 250 PRINT 260 PRINT "THE RANGE AND INPUT THE" 270 PRINT 280 PRINT "PROPER ELEVATION WHICH" 290 PRINT 300 PRINT "IS OFTEN A DECIMAL SUCH AS" 310 PRINT 320 PRINT "65.3 FOR INSTANCE. THE COM-" 330 PRINT 340 PRINT "PUTER WILL TELL YOU WHETHER" 350 PRINT 360 PRINT "YOUR SHOT IS LONG OR SHORT" 370 PRINT 380 PRINT "AND BY HOW MANY METERS." 390 FOR DLAY=1 TO 2000 400 NEXT DLAY 410 CALL CLEAR 420 PRINT "WHEN YOU STRIKE THE TARGET," 430 PRINT 440 PRINT "THE COMPUTER WILL TELL YOU" 450 PRINT 460 PRINT "HOW MANY SHOTS YOU FIRED." 470 PRINT 480 PRINT "GOOD LUCK!!!" 490 PRINT 500 PRINT 510 PRINT 520 PRINT "PRESS (ENTER) TO CONTINUE." 530 INPUT ER$ 540 RANDOMIZE 550 Y=59000-INT(RND*24000)+1 560 CALL CLEAR 570 PRINT "MAXIMUM RANGE IS 60,000" 580 PRINT "METERS. DISTANCE TO TARGET" 590 PRINT "IS";Y;"METERS." 600 PRINT 610 PRINT "ELEVATION" 620 INPUT E 630 CALL SOUND(250,-6,0) 640 NJ=NJ+1 650 IF E<85 THEN 1040 660 IF E>95 THEN 860 670 CALL CLEAR 680 PRINT "YOUR SHOT WENT STRAIGHT UP!" 690 PRINT 700 FOR I=1 TO 10 710 FOR DLAY=1 TO 150 720 NEXT DLAY 730 PRINT TAB(15);"." 740 CALL SOUND(100,1500,0) 750 NEXT I 760 PRINT TAB(13);"BOOM!!" 770 FOR DLAY=1 TO 50 780 NEXT DLAY 790 CALL SOUND(2000,-6,0) 800 CALL SCREEN(1) 810 FOR DLAY=1 TO 100 820 NEXT DLAY 830 CALL SCREEN( 840 CALL CLEAR 850 GOTO 610 860 CALL CLEAR 870 PRINT "THAT SHOULD MAKE YOU A HERO!" 880 PRINT "THAT ROUND MIGHT HIT MARS!" 890 C=1 900 FOR DLAY=1 TO 750 910 NEXT DLAY 920 GOTO 840 930 CALL CLEAR 940 PRINT TAB(3);"NEWS FLASH!!!" 950 PRINT 960 PRINT 970 PRINT "MARS STRUCK" 980 PRINT "BY MYSTERY PROJECTILE!!" 990 PRINT 1000 C=0 1010 RETURN 1020 PRINT "ILLEGAL!!" 1030 GOTO 840 1040 IF C<>1 THEN 1060 1050 GOSUB 930 1060 IF E<1 THEN 1020 1070 E2=2*E/57.2958 1080 J=60000*SIN(E2) 1090 N=Y-J 1100 D=INT(N) 1110 IF ABS(D)< 100 THEN 1140 1120 IF Y-J<0 THEN 1330 1130 IF Y-J > 0 THEN 1350 1140 CALL CLEAR 1150 CALL SOUND(4000,-6,0) 1160 CALL SCREEN(2) 1170 FOR DLAY=1 TO 850 1180 NEXT DLAY 1190 CALL CLEAR 1200 CALL SCREEN(8) 1210 PRINT "TARGET DESTROYED !!!" 1220 PRINT 1230 PRINT 1240 PRINT 1250 PRINT 1260 PRINT "YOU FIRED";NJ;"ROUNDS!!" 1270 PRINT 1280 PRINT 1290 PRINT 1300 INPUT "PRESS (ENTER) TO CONTINUE":ER$ 1310 NJ=0 1320 GOTO 560 1330 PRINT "SHORT BY";ABS(D);"YARDS" 1340 GOTO 610 1350 PRINT "LONG BY";ABS(D);"YARDS" 1360 GOTO 610 Edited October 15, 2022 by oddemann Fixed bug! 2 Quote Link to comment Share on other sites More sharing options...
digdugnate Posted May 17, 2019 Share Posted May 17, 2019 Interesting- I wonder if this is the same Douglas E Smith that did Lode Runner? Duck Leader Douglas E. Smith and Douglas W. Smith This is no time to be feather-brained or daffy. There are hunters lurking in the maze of reeds ahead, and ifyou make a wrong turn, you and your friends will be duck soup. Two skill levels, ten difficulty ratings. This game will challenge your skill and memory. Your assignment, as the leader of a squadron of 30 ducks, is to direct them through a series of marsh mazes to the safety of a duck sanctuary. You must swim through five different mazes, each of which has invisible reed patches and hidden hunters. The reeds will send you back to the beginning of the maze. If you find a hunter, you will lose a duck. Save as many ducks as possible for a high score. Lose your squadron and it's all over. Favorite Duck After typing in the program, it's a good idea to list the program, check for errors, and then save a copy to tape or disk before running the program. When you start the game, the title graphics will appear, followed by several questions. 1. LEVEL=?(1=HELP/ 2=NO HELP) Enter 1 until you have gained confidence in your memory and problem-solving ability. With level 1 you may use the H key to quickly view the location of the reeds and hunters in the marsh (up to five times during one game). Level 2 will double your possible score, but you cannot use the H key for help. 2. DIFFICULTY=(1-10) I For your first game, enter 1. After some practice try the other difficulty ratings. Ratings 1-4 are easy, 5-7 are hard, and 8-10 are very challenging. The difficulty rating determines the complexity of the maze. 3. INSTRUCTIONS ? (Y/N) Enter Y to read the instructions before the game begins. This screen briefly describes the game and the functions of the appropriate keys used for the game. It also shows the graphic characters used for the reeds, hunters, and the marsh exit. 4. FIRST NAME OF THE LEAD DUCK? Type in your first name or the name of your favorite duck, and press ENTER. The game will then begin. If you entered Y for instructions, they will appear first. Hit the 1 key to begin play. At first the outline of the marsh appears, and then the positions of the reeds and hunters are indicated. You have 15 seconds to study the locations before the reeds and hunters become invisible. Successful Maneuvers The duck on the left side of the marsh represents your squadron. Move the duck by using the arrow keys (E, S, D, and X). You do not have to press ENTER or use the FCTN key. If you hit the sides of the marsh or the invisible reed, your ducks will bounce back to the starting position, but you do not lose any ducks. Meeting a hunter will result in gunfire and the loss of a duck, with the survivors returning to the start again. The positions of the reeds and hunters do not change until you reach the exit to the next marsh. Your goal is to maneuver your squadron to the right side of the marsh and out the exit to the next marsh. Once you have passed through the five marshes to safety, the program will congratulate you, show you the remaining ducks, and print your score. The highest possible score is 6000 and can be achieved only at level 2 with the difficulty rating 10. Nobody has achieved this score to date. The marsh border color changes to red if the squadron is depleted to ten or fewer ducks. Losing all the squadron will put you in Duck Soup, and give you a zero score. After the score is printed, the program will ask PLAY AGAIN? (Y/N). Enter Y to play again at the last selected level and difficulty. Enter N to choose a different level and difficulty. The Hkey may be used if you selected level 1. Pushing the H key while playing the game will give you a quick look at the marsh. Using this key does not change the position of the duck. You are limited to only five helps per game. Remember the highest score using level 1 will be half that of level 2. On occasion, the program will generate a maze which is impossible to cross. (Ducks don't always have it easy, do they?) Press the N key and you will move to a new marsh. The change in marshes will cost the squadron five ducks, so use the N key only if there is no way out. Some Noteworthy Routines The "Duck Leader" program employs several very useful TI BASIC routines. Creation of the maze is accomplished using the RND function to place the reeds and hunters (lines 620-670). The CALL GCHAR in line 800 tests the randomly determined position for characters already present on the marsh. Line 800 checks to see if an empty space is present and, if not, calls for a new set of coordinates to be generated. The CALL KEY routine (line 890) is used to move the duck through the marsh. Keys 68, 69, 83, and 88 determine the direction of the move. Once again the CALL GCHAR is used to test for an empty space. If found, the duck is printed in that position. If a reed or hunter is found, lines 1250-1260 execute the proper action. Several loops and counters pause the program and keep track of the ducks. Lines 690-720 give you time to view the maze before the characters become invisible. The H key sends the program to lines 1140-1220, making the maze visible. The ducks left are counted in lines 980 and 1310. The number of marshes traversed is counted in line 1380. The score is calculated in line 1550 and the ducks saved in line 1540. Changing the Difficulty You may wish to make the game less difficult by making one or more of the following changes: 1. Set the final value in the FOR-NEXT loop in line 690 to a higher value to increase the length of time you have to view the maze. 2. Increase the final value for Xin the FOR-NEXT loop beginning in line 1170 to give you a longer look when you use the H key. 3. Change the 5 in line 1150 to a greater number to increase the number of times you can use the H key. Duck Leader 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 21, 2019 Author Share Posted May 21, 2019 (edited) Sprite fun! EX B.http://aa-ti994a.oratronik.de/smart_programming_guide_for_sprites.pdf Spoiler 100 CALL CLEAR :: CALL SCREEN(2) :: CALL CHAR(46,"0000001818") :: CALL SPRITE(#2,94,16,180,1,0,5) 110 FOR N=0 TO 25 :: RANDOMIZE :: CALL PEEK(-31808,Y,X):: CALL SPRITE(#3,65+N,16,Y/2+1,X+1):: CALL SOUND(-60,660,8) 120 CALL POSITION(#3,Y,X,#2,R,C) :: CALL SPRITE(#1,46,16,R,C,(Y-R)*.49,(X-C)*.49) :: CALL SOUND(476,-3,14) 130 CALL SOUND(120,110,6)::CALL DELSPRITE(#1):: CALL PATTERN(#3,35):: CALL SOUND(100,220,6):: NEXT N :: GOTO 110 Edited October 15, 2022 by oddemann Fixed bug! 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted May 21, 2019 Author Share Posted May 21, 2019 So simpel and so few lines and it is almost a game aready!Same PDF as above DOTS 100 CALL CLEAR :: CALL SCREEN(11):: CALL CHAR(33,"000000006060",96,"AAFFFEDFBEBBBEBFAAFFFE8F8E9B9E9FAAFFDEFFFEF70EFFAAFFDEFFE60706FF") 110 CALL CHAR(100,"BFBEBBBEDFFEFFAA9F9E9B8E8FFEFFAA55FF7BFF7FEF70FF55FF7BFF67E060FF"):: CALL COLOR(1,15,2,2,5,5) 120 CALL HCHAR(24,1,40,64)::CALL VCHAR(1,31,40,96):: P=102 :: CALL SPRITE(#1,P,16,17,17) 130 FOR R=1 TO 50 :: RANDOMIZE :: CALL PEEK(-31808,X,Y) :: CALL HCHAR(INT(X/12)+2,INT(Y/10)+4,33) :: NEXT R :: R,C=3 140 CALL JOYST(1,X,Y):: IF X AND Y THEN 140 ELSE IF X THEN P=100+X/2 :: X=SGN(X) ELSE IF Y THEN P=98+Y/2 :: Y=-SGN(Y) 150 CALL GCHAR(R+Y,X+C,CH) :: IF CH=40 THEN CALL SOUND(-60,110,9) :: GOTO 140 ELSE C=C+X :: R=R+Y 160 CALL PATTERN(#1,P):: CALL LOCATE(#1,R*8-7,C*8-7):: IF CH=33 THEN CALL SOUND(-100,-7,6) :: CALL HCHAR(R,C,32) 170 CALL PATTERN(#1,P+1) :: IF X OR Y THEN CALL SOUND(-90,660,9) :: CALL HCHAR(R-Y,C-X,40) :: GOTO 140 ELSE 140 3 Quote Link to comment Share on other sites More sharing options...
oddemann Posted October 15, 2022 Author Share Posted October 15, 2022 On 5/12/2019 at 11:25 PM, TheBF said: A simple spinner sub-routine. Might be useful for BASIC game makers. The x,y coordinates could be variables of course. My SPINN on it... 100 CALL CLEAR 110 CALL CHAR(128,"1C02010101000000") 120 CALL CHAR(129,"000000010101021C") 130 CALL CHAR(130,"0000008080804038") 140 CALL CHAR(131,"3840808080000000") 150 PRINT "Spinner Demo" 160 PRINT "press a key to stop" 170 PRINT 180 GOSUB 9000 190 PRINT "Spinner stopped" 200 END 9000 TIME=8 :: REM TIME is to slow it down 9001 CALL HCHAR(1,1,128) 9002 FOR I=1 TO TIME 9003 NEXT I 9010 CALL HCHAR(1,1,129) 9011 FOR I=1 TO TIME 9012 NEXT I 9020 CALL HCHAR(1,1,130) 9021 FOR I=1 TO TIME 9022 NEXT I 9030 CALL HCHAR(1,1,131) 9032 FOR I=1 TO TIME 9033 NEXT I 9040 CALL KEY(0,K,S) 9050 IF S=0 THEN 9000 9060 CALL HCHAR(1,1,32) 9070 RETURN 1 Quote Link to comment Share on other sites More sharing options...
+TheBF Posted October 15, 2022 Share Posted October 15, 2022 Ha. That was a long time ago. You might want to organize the code like this. The time delay is in one place. 100 CALL CLEAR 110 CALL CHAR(128,"1C02010101000000") 120 CALL CHAR(129,"000000010101021C") 130 CALL CHAR(130,"0000008080804038") 140 CALL CHAR(131,"3840808080000000") 150 PRINT "Spinner Demo" 160 PRINT "press a key to stop" 170 PRINT 180 TIME=5 190 GOSUB 1000 200 CALL KEY(0,K,S) 210 IF S=0 THEN 190 220 PRINT "Spinner stopped" 230 END 1000 REM Spinner sub-routine 1001 CALL HCHAR(1,1,128) 1002 GOSUB 9010 1010 CALL HCHAR(1,1,129) 1011 GOSUB 9010 1020 CALL HCHAR(1,1,130) 1022 GOSUB 9010 1030 CALL HCHAR(1,1,131) 1033 GOSUB 9010 1070 RETURN 9000 REM delay 9010 FOR T=1 TO TIME 9020 NEXT T 9999 RETURN 1 Quote Link to comment Share on other sites More sharing options...
oddemann Posted October 16, 2022 Author Share Posted October 16, 2022 (edited) 18 hours ago, TheBF said: Ha. That was a long time ago. You might want to organize the code like this. The time delay is in one place. OK... I made it bigger, but there is a slight hold at the start... is it possible to make it move more even around and around? Spoiler 100 CALL CLEAR 110 CALL CHAR(128,"C038040000000000") 120 CALL CHAR(129,"0000040202020101") 130 CALL CHAR(130,"0101020202040000") 140 CALL CHAR(131,"00000000000438C0") 150 CALL CHAR(132,"0000000000201C03") 160 CALL CHAR(133,"8080404040200000") 170 CALL CHAR(134,"0000204040408080") 180 CALL CHAR(135,"031C200000000000") 190 PRINT "Spinner Demo Ver 4" 200 PRINT "press a key to stop" 210 PRINT 220 TIME=3 230 GOSUB 1000 240 CALL KEY(0,K,S) 250 IF S=0 THEN 230 260 PRINT "Spinner stopped" 270 END 1000 REM Spinner sub-routine 1010 CALL HCHAR(1,2,128) 1020 GOSUB 9010 1040 CALL HCHAR(1,2,129) 1050 GOSUB 9010 1055 CALL HCHAR(1,2,32) 1060 CALL HCHAR(2,2,130) 1070 GOSUB 9010 1080 CALL HCHAR(2,2,131) 1090 GOSUB 9010 1095 CALL HCHAR(2,2,32) 1100 CALL HCHAR(2,1,132) 1110 GOSUB 9010 1120 CALL HCHAR(2,1,133) 1130 GOSUB 9010 1135 CALL HCHAR(2,1,32) 1140 CALL HCHAR(1,1,134) 1150 GOSUB 9010 1160 CALL HCHAR(1,1,135) 1170 GOSUB 9010 1175 CALL HCHAR(1,1,32) 1180 RETURN 9000 REM delay 9010 FOR T=1 TO TIME 9020 NEXT T 9999 RETURN Edited October 16, 2022 by oddemann Quote Link to comment Share on other sites More sharing options...
oddemann Posted October 16, 2022 Author Share Posted October 16, 2022 (edited) Hmmm, if I go this way... DATA 32,"00" DATA 1,2,128,"C038040000000000" DATA 1,2,129,"0000040202020101" DATA 2,2,130,"0101020202040000" DATA 2,2,131,"00000000000438C0" DATA 2,1 132,"0000000000201C03" DATA 2,1 133,"8080404040200000" DATA 1,1,134,"0000204040408080" DATA 1,1,135,"031C200000000000" Read Char nr., "pic" Display it in a for-next loop - LINE NR CALL HCHAR(A,B,C) Then GOSUB the time delay Maybe even not have Char 32 in DATA as it is the same... would that make it more even? Edited October 16, 2022 by oddemann 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.