The source for the programs is credited. Many thanks to James Host for sharing some of his extraordinary hacks, and for the copies of the Tutor User Club newsletters from which others here originated.
Programs are more or less in ascending level of hack-dom, with the most egregious and complex hacks at the end, and more conventional programs at the beginning.
Please report any and all typos ASAP, as these were keyed by hand ;-)
NEW 100 CLS 110 RANDOMIZE 120 MCELL(128,"0066FFFFFF7E3C18") 130 DEF FN(X)=INT(RND*14+2) 140 FOR T=0 TO 10 150 C=FN(C) 160 PRINT "SINECURVE" 170 COLOR(1,FN(A),C) 180 SCREEN(C) 190 FOR P=0 TO 12.4 STEP .4 200 SOUND(25,150+30*FN(C),3) 210 PRINT TAB(6*(2+SIN(P)));CHR$(128) 220 NEXT P 230 NEXT T RUN
NEW 100 DIM N(7,4),S(7,4),L(250),R(250) 110 FOR I=1 TO 4 :: FOR J=1 TO 7 :: READ N(J,I) :: NEXT J :: NEXT I 120 FOR I=1 TO 4 :: FOR J=1 TO 7 :: READ S(J,I) :: NEXT J :: NEXT I 125 GOSUB 700 130 C=0 :: Q=0 :: K=1 140 GOSUB 600 :: R(C)=M :: IF Q=0 THEN 140 150 C=0 :: Q=0 :: K=1 160 GOSUB 600 :: L(C)=M :: IF Q=0 THEN 160 170 FOR I=1 TO C :: SOUND(D,R(I),V,L(I),V) :: NEXT I 180 PRINT "PLAY IT AGAIN"; :: INPUT F$ :: IF SEG$(F$,1,1)="Y" THEN 170 190 END 600 READ F$ :: IF SEG$(F$,1,1)="K" THEN K=VAL(SEG$(F$,2,1)) :: GOTO 690 610 IF F$="R" THEN M=40000 :: GOTO 680 620 IF F$="Q" THEN Q=1 :: GOTO 690 630 M=N(ASC(SEG$(F$,1,1)) AND 7,K) :: IF LEN(F$)=2 THEN M=S(ASC(SEG$(F$,1,1)) AND 7,K) 680 C=C+1 690 RETURN 700 D=30 :: V=3 :: SCREEN(13) :: CLS :: COLOR(0,16,2) 710 PRINT " CANNED MUSIC" :: FOR I=1 TO 10 :: PRINT :: NEXT I 790 RETURN 1000 ! NOTE TABLE - NATURAL 1010 DATA 110,123,131,147,165,175,196 1020 DATA 220,247,262,294,330,349,392 1030 DATA 440,494,523,587,659,698,784 1040 DATA 880,988,1047,1175,1319,1397,1568 1100 ! NOTE TABLE - SHARPS 1110 DATA 117,131,139,156,175,185,208 1120 DATA 233,262,277,311,349,370,415 1130 DATA 466,523,554,622,698,740,831 1140 DATA 932,1047,1109,1245,1397,1480,1661 2000 ! NOTES FOR RIGHT HAND 2010 DATA K3,C,C,C,D,E,R,D,R,C,E,D,D,C,R,R,R 2020 DATA C,C,C,D,E,R,D,R,C,E,D,D,C,R,R,R 2030 DATA D,D,D,D,A,R,A,R,D,C,B,A,K2,G,K3,R,R,R 2040 DATA C,C,C,D,E,R,D,R,C,E,D,D,C,R,R,R 2090 DATA Q 3000 ! NOTES FOR LEFT HAND 3010 DATA K2,C,G,E,G,C,G,F,G,E,G,F,G,E,G,E,D 3020 DATA C,G,E,G,C,G,F,G,E,G,F,G,E,G,C,R 3030 DATA D,E,F,E,D,E,F,D,F#,E,D,C,B,F,E,D 3040 DATA C,G,E,G,C,G,F,G,E,G,F,G,E,G,C,R 3090 DATA Q RUNFour octaves available, from K1 to K4 inclusive. Data must be terminated with a Q for each of two hands. R is for rest. Octaves run from notes A to G, inclusive, ascending.
[x spaces]
appears, type x number of space characters.
130 PRINT TAB(4);"AMORTIZATION PROGRAM" 150 PRINT 160 INPUT "LOAN[7 spaces]$":X 170 INPUT "INTEREST[3 spaces]%":I 180 INPUT "TIME[4 spaces]YRS.":Y 190 LET A=X 200 P=X*((I/12)/(1-(1/(1+(I/12))^(Y*12)))) 210 CLS 240 PRINT "TIME IN MONTHS";Y*12 250 PRINT "PAYMENT";P 260 PRINT "USE MOD TO STOP" 262 PRINT "TYPE CONT TO CONTINUE" 270 PRINT 280 PRINT TAB(1);"MO";TAB(7);"INT";TAB(14);"PRINC";TAB(21);"BAL" 290 PRINT 300 FOR M=1 TO (Y*12) 310 I1=(I/12)*X 320 X=X-(P-I1) 330 TP=M*P 340 PRINT TAB(1);M;TAB(6);INT(I1);TAB(13);INT(P-I1);TAB(20);INT(X) 350 NEXT M 360 PRINT 370 PRINT "TOTAL PRINC[1 space]";A 380 PRINT "TOTAL INT[3 spaces]";TP-A 390 PRINT "TOTAL PAYMT[1 space]";TP
120 REM FOR JOY CONTROLLERS 130 S=1::X=15::Y=13 140 CLS::SCREEN(2)::COLOR(3,5,5) 150 KEY(1,K)::IF (K<=0)+(K>16) THEN 150 160 IF K<>6 THEN 210 170 S=S*-1 180 COLOR(3,9,9) 190 IF S=-1 THEN 250 200 COLOR(3,5,5) 210 IF K=1 THEN XDIR=1::YDIR=0::GOTO 250 220 IF K=2 THEN YDIR=-1::XDIR=0::GOTO 250 230 IF K=4 THEN XDIR=-1::YDIR=0::GOTO 250 240 IF K=8 THEN YDIR=1::XDIR=0 250 X=X+XDIR::Y=Y+YDIR 260 X=INT(32*((X-1)/32-INT((X-1)/32)))+1 270 Y=INT(24*((Y-1)/24-INT((Y-1)/24)))+1 280 SCELL(Y,X,144) 290 GOTO 150
SCELL's bounds-checking bug to
directly manipulate VDP RAM. Type carefully, as a typo in this program
could crash the system, but it's very worth it.
115 PRINT "HIT SPACE BAR TO QUIT" :: FOR J=1 TO 500 :: NEXT J 120 FOR J=1313 TO 1282 STEP -1 :: K=((J AND 15)+16*(J AND 15)+160) AND 255 130 SCELL(24,32,K,J) :: SCELL(24,32,160,257) :: NEXT J 160 FOR J=1 TO 32 :: FOR K=1 TO 24 170 SCELL(K,J,(J-1)*8 AND 255) 180 NEXT K :: NEXT J 190 FOR J=0 TO 23 :: SCELL(J+1,J+1,J*8,32-J) :: NEXT J 200 KEY(0,Q) :: IF Q THEN 210 ELSE 200 210 SCELL(24,32,160,257) :: CLS :: END
100 DIM A(256) 110 S=129 120 K=1 130 FOR J=S TO 5 STEP -4 140 K=K+1 150 A(J)=INT(RND*14)+1 160 A(J-1)=(K AND 15)+65 170 A(J-2)=(K*5+166) AND 255 180 A(J-3)=(K*4+158) AND 255 190 NEXT J 200 CLS :: SCREEN(16) 210 SCELL(1,1,255,768) 220 COLOR(0,16,13) :: A$="HIT SPACE BAR" 230 FOR J=S TO 1 STEP -1 240 SCELL(24,32,A(J),J) 250 NEXT J 260 FOR Z=1 TO LEN(A$) :: SCELL(24,3+Z,ASC(SEG$(A$,Z,1))) :: NEXT Z 270 FOR J=0 TO 185 :: KEY(0,Q) :: IF Q THEN 320 280 SCELL(24,32,(J+158) AND 255,2) :: NEXT J 290 FOR J=185 TO 0 STEP -1 :: KEY(0,Q) :: IF Q THEN 320 300 SCELL(24,32,(J+185) AND 255,2) :: NEXT J 310 GOTO 270 320 SCREEN(13) :: CLS :: PRINT "SCELL(24,32,0,129)" 330 PRINT " TO ERASE SPRITES." :: ENDLine 150 sets sprite color. Line 160 sets sprite character (for fun, substitute 30 for the expression on the right). Lines 170-180 set sprite coordinates. Line 210 keeps the screen blank. Lines 230-250 do the actual SCELLing which places the sprites. Lines 270-310 bounce the first sprite until a key is pressed.
It is still much more convenient to do sprite operations in GBASIC, but this program demonstrates the true power of the 9918A.