A.N.A.L.O.G. Magazine 1985 July

home *** CD-ROM | disk | FTP | other *** search

/ A.N.A.L.O.G. Magazine 1985 July / 85_jul.atr / shapes.act < prev next >

Wrap

Text File | 2023-02-26 | 8KB | 1 lines

; COLOR THE SHAPES¢;¢; by Rebecca Guber and Sol Guber¢¢MODULE¢¢BYTE ARRAY¢ R(100),USED(60),PLAYER(20),B(90),¢ CLS=704,A(10),GAR(60),¢ INTER=[72 169 0 141 10 212 141 27¢ 208 104 64],¢ TX=[0 252 0 4],TY=[248 0 8 0],¢ TEST=[246 255 10 1],¢ COLORS=[8 122 88 28 132 248 190¢ 14 190],¢ STAR=[0 0 0 0 24 126 60 60 126 24¢ 0 0 0 0]¢¢CARD SC1,YP1,YP,Y1¢BYTE CFLAG,COL,PLAYNUM,COUNT,DX,DY,¢ OLDX,OLDY,X,Y,TURN,QUIT¢¢PROC SETUP()¢CARD Z¢Z=PEEKC(560)¢POKE(Z+166,143)¢POKEC(512,INTER)¢POKE(54286,192)¢POKE(87,10)¢POKE(623,160)¢FOR Z=0 TO 8 DO¢ CLS(Z)=PEEK(COLORS+Z)¢OD¢RETURN¢¢PROC BLOCK(BYTE I)¢BYTE J¢FOR J=152 TO 157 DO¢ PLOT (I,J)¢ DRAWTO(I+5,J)¢OD¢RETURN¢¢PROC NEWDIR(BYTE A,B)¢DX=0¢DY=0¢IF LOCATE(A+1,B)>0 THEN¢ DX=1¢ELSEIF LOCATE(A-1,B)>0 THEN¢ DX=-1¢ELSEIF LOCATE(A,B-1)>0 THEN¢ DY=-1¢ELSE¢ DY=1¢FI¢RETURN¢¢BYTE FUNC LINE(BYTE A,B)¢BYTE Z,J¢Z=LOCATE(A+1,B)¢J=LOCATE(A-1,B)¢Z==+J¢J=LOCATE(A,B+1)¢Z==+J¢J=LOCATE(A,B-1)¢Z==+J¢IF Z>6 THEN¢ RETURN(Z)¢FI¢NEWDIR(A,B)¢RETURN(1)¢¢PROC REMOVE(BYTE A,B)¢DO¢ PLOT(A,B)¢ A==+DX¢ B==+DY¢ UNTIL LINE(A,B)<>1¢OD¢RETURN¢¢PROC GRID()¢BYTE I,X,Y,Z,XOLD,YOLD,Y1¢COLOR=6¢I=2¢WHILE I<157 DO¢ PLOT(3,I)¢ DRAWTO(74,I)¢ I==+16¢OD¢I=3¢WHILE I<79 DO¢ PLOT(I,2)¢ DRAWTO(I,145)¢ I==+8¢OD¢FOR I=2 TO 5 DO¢ COLOR=I¢ BLOCK((I-2)*10+5)¢OD¢COLOR=6¢PLOT(45,153)¢DRAWTO(50,153)¢DRAWTO(50,157)¢DRAWTO(45,157)¢DRAWTO(45,153)¢PLOT(51,158)¢COLOR=0¢FOR I=1 TO 40 DO¢ DO¢ X=RAND(8)*8+7¢ Y=RAND(16)*8+10¢ Y1=Y-10¢ IF Y1/8=(Y1/16)*2 THEN¢ X==+4¢ FI¢ UNTIL LOCATE(X,Y)<>0¢ OD¢ XOLD=X¢ YOLD=Y¢ IF Y1/8=(Y1/16)*2 THEN¢ DX=0¢ DY=-1¢ REMOVE(X,Y)¢ DX=0¢ DY=1¢ REMOVE(XOLD,YOLD)¢ ELSE¢ DY=0¢ DX=-1¢ REMOVE(X,Y)¢ DY=0¢ DX=1¢ REMOVE(XOLD,YOLD)¢ FI¢OD¢RETURN¢¢PROC TITLE()¢BYTE X,Y,C,K1,K2¢CARD SC,J¢SC1=PEEKC(88)¢GRAPHICS(19)¢SC=PEEKC(560)¢FOR J=7 TO 9 DO¢ POKE(SC+J,7)¢OD¢POKE(87,2)¢COLOR=0¢PLOT(0,1)¢PRINTDE(6,"COLOR THE SHAPES")¢PRINTDE(6," by rebecca guber")¢PRINTDE(6," Ĳמגáצנכáוראדפ")¢POKE(87,3)¢FOR J=1 TO 1000 DO¢ FOR K2=1 TO 500 DO¢ OD¢ X=RAND(39)¢ Y=RAND(12)+8¢ C=RAND(255)¢ SOUND(0,C,8,8)¢ COLOR=RAND(4)¢ PLOT(X,Y)¢OD¢SOUND(0,0,0,0)¢RETURN¢¢BYTE FUNC NEWSPOT(BYTE J,COUNT)¢BYTE K,Y1,X1,Z,K1¢R(J)==+128¢Y1=((J-1)/10)*16+10¢X1=((J-1) MOD 10)*8+7¢FOR K=0 TO 3 DO¢ Z=LOCATE(X1+TX(K),Y1+TY(K))¢ K1=J+TEST(K)¢ IF Z=0 AND R(K1)=0 THEN¢ R(K1)=COUNT¢ RETURN(K1)¢ FI¢OD¢RETURN(0)¢¢BYTE FUNC OLDSPOT(BYTE J,COUNT)¢BYTE K,K1¢R(J)==-128¢K=3¢WHILE K<>255 DO¢ K1=J+TEST(K)¢ IF K1>0 AND K1<100 THEN¢ IF R(K1)>128 THEN¢ R(K1)==-128¢ RETURN(K1)¢ FI¢ FI¢ K==-1¢OD¢RETURN(0)¢¢PROC FIND(BYTE J,COUNT)¢BYTE K,K1¢R(J)=COUNT¢DO¢ K=NEWSPOT(J,COUNT)¢ IF K=0 THEN¢ K1=OLDSPOT(J,COUNT)¢ J=K1¢ ELSE¢ J=K¢ FI¢ UNTIL J=0¢OD¢RETURN¢¢PROC SEARCH()¢BYTE J,COUNT,K,K1¢ZERO(R,100)¢COUNT=1¢FOR J=1 TO 89 DO¢ IF R(J)=0 AND J MOD 10<>0 THEN¢ FIND(J,COUNT)¢ COUNT==+1¢ FI¢OD¢FOR J=1 TO 89 DO¢ IF R(J)>128 THEN¢ R(J)==-128¢ FI¢OD¢RETURN¢¢; PMG.ACT FROM THE ACTION! TOOLKIT¢¢INCLUDE "D1:PMG.ACT"¢¢¢BYTE FUNC SIZE(BYTE K)¢BYTE J ¢FOR J=K+1 TO K+9 DO¢ IF R(J)=COUNT THEN¢ RETURN(1)¢ FI¢OD¢RETURN(0)¢¢¢PROC CHECK_BOARD()¢BYTE J,K¢COUNT=1¢FOR J=1 TO 99 DO¢ IF J MOD 10 <>0 THEN¢ WHILE R(J)<COUNT AND J<100 DO¢ J==+1¢ OD¢ GAR(COUNT)=J/10¢ K=(J/10)*10+10¢ WHILE SIZE(K)=1 DO¢ K==+10¢ OD¢ GAR(COUNT)==+(K-10)¢ COUNT==+1¢ FI¢OD¢COUNT==-1¢RETURN¢¢PROC SHIFT(BYTE X1)¢BYTE Z,Z1¢IF X1=140 THEN¢ QUIT=1¢ RETURN¢FI¢Z=(X1-60)/20+1¢COL=Z+1¢Z1=PEEK(705+Z)-6¢POKE(705,Z1)¢RETURN¢¢PROC BEEP()¢CARD Q¢SOUND(0,220,10,10)¢FOR Q=1 TO 25000 DO¢OD¢SOUND(0,0,0,0)¢RETURN¢¢BYTE FUNC PICK_COLOR()¢BYTE S,TR,J,X1¢CARD I1¢FOR I1=OLDY TO 173 DO¢ PMMOVE(1,X,I1)¢OD¢OLDY=173¢PRINTE("PLEASE PICK A COLOR")¢X1=60¢PMHPOS(1)=60¢IF CFLAG=1 THEN¢ DO¢ J=PEEK(624)¢ IF J>5 THEN¢ J=(J/50)*20+60¢ PMHPOS(1)=J¢ FI¢ IF PEEK(636)=0 OR¢ PEEK(637)=0 THEN¢ BEEP()¢ SHIFT(J)¢ RETURN(1)¢ FI¢ OD¢FI¢DO¢ DO¢ S=STICK(0)¢ TR=STRIG(0)¢ IF TR=0 THEN¢ BEEP()¢ SHIFT(X1)¢ RETURN(1)¢ FI¢ UNTIL S<>15¢ OD¢ IF S=7 THEN¢ X1==+20¢ IF X1=160 THEN¢ X1=60¢ FI¢ FI¢ IF S=11 THEN¢ X1==-20¢ IF X1=40 THEN¢ X1=140¢ FI¢ FI¢ PMHPOS(1)=X1¢ FOR I1=1 TO 6000 DO¢ OD¢OD¢RETURN(1)¢¢BYTE FUNC GOOD_COLOR(BYTE SPOT,COL)¢BYTE TOP,BOT,BLOCK,I¢BLOCK=R(SPOT)¢TOP=GAR(BLOCK)¢BOT=(TOP MOD 10)*10¢TOP=(TOP/10)*10¢WHILE BOT<TOP+9 DO¢ IF R(BOT)=BLOCK THEN¢ FOR I=0 TO 3 DO¢ IF B(BOT+TEST(I))=COL THEN¢ RETURN(0)¢ FI¢ OD¢ FI¢ BOT==+1¢OD¢RETURN(1)¢¢PROC FILLER(BYTE J)¢BYTE X,Y,K,L,L1¢L1=6¢IF R(J)=R(J+1) THEN¢ L1==+1¢FI¢L=14¢IF R(J)=R(J+10) THEN¢ L==+1¢FI¢X=(J/10)*16+3¢Y=(J MOD 10)*8-4¢FOR K=X TO X+L DO¢ PLOT(Y,K)¢ DRAWTO(Y+L1,K)¢OD¢RETURN¢¢PROC FILL_IN(BYTE SPOT)¢BYTE N,TOP,BOT,J¢N=R(SPOT)¢TOP=GAR(N)¢BOT=TOP MOD 10¢TOP=(TOP/10)*10¢USED(N)=1¢FOR J=BOT TO TOP+9 DO¢ IF R(J)=N THEN¢ B(J)=COLOR¢ FILLER(J)¢ FI¢OD¢RETURN¢¢PROC INIT()¢BYTE K,J,M,N,C¢ZERO(PLAYER,20)¢ZERO(B,99)¢ZERO(USED,60)¢PUT(125)¢PRINTE("1 OR 2 PLAYERS?")¢PLAYNUM=INPUTB()¢PRINTE("WHAT IS YOUR NAME?")¢INPUTS(A)¢FOR K=1 TO A(0) DO¢ PLAYER(K)=A(K)¢OD¢IF PLAYNUM=2 THEN¢ PRINTE("NAME OF 2ND PLAYER?")¢ INPUTS(A)¢ FOR K=1 TO A(0) DO¢ PLAYER(K+10)=A(K)¢ OD¢FI¢PUT(125)¢PRINT("USE A KOALA PAD (Y/N)?")¢CFLAG=0¢INPUTS(A)¢IF A(1)='Y THEN¢ CFLAG=1¢FI¢PRINTE("FILL SOME SHAPES IN?")¢INPUTS(A)¢IF A(1)<>'Y THEN¢ RETURN¢FI¢PUT(125)¢PRINTE("HOW MANY SHAPES, UP TO 5?")¢J=INPUTB()¢J==MOD 6¢FOR K=1 TO J DO¢ DO¢ M=RAND(COUNT-1)+1¢ UNTIL USED(M)=0¢ OD¢ N=M¢ DO¢ N==+1¢ UNTIL R(N)=M¢ OD¢ DO¢ C=RAND(4)+2¢ UNTIL GOOD_COLOR(N,C)=1¢ OD¢ COLOR=C¢ FILL_IN(N)¢ USED(M)=1¢OD¢RETURN¢¢BYTE FUNC SGN(BYTE I,J)¢IF I=J THEN¢ RETURN(0)¢ELSEIF I>J THEN¢ RETURN(-1)¢FI¢RETURN(1)¢¢PROC MOVE()¢BYTE Q,DEL¢CARD K¢IF OLDX<>X THEN¢ Q=OLDX¢ DEL=SGN(OLDX,X)¢ WHILE Q<>X DO¢ PMMOVE(1,Q,OLDY)¢ Q==+DEL¢ OD¢ OLDX=X¢ FOR K=1 TO 2000 DO¢ OD¢FI¢IF OLDY<>Y THEN¢ Q=OLDY¢ DEL=SGN(OLDY,Y)¢ WHILE Q<>Y DO¢ PMMOVE(1,X,Q)¢ Q==+DEL¢ OD¢ OLDY=Y¢FI¢RETURN¢¢BYTE FUNC TRIGGER()¢IF CFLAG=1 THEN¢ IF PEEK(636)=0 OR PEEK(637)=0 THEN¢ RETURN(0)¢ FI¢ELSE¢ IF STRIG(0)=0 THEN¢ RETURN(0)¢ FI¢FI¢RETURN(1)¢¢BYTE FUNC ABS(BYTE A,B)¢IF A>B THEN¢ RETURN(A-B)¢FI¢RETURN(B-A)¢¢BYTE FUNC JOYSTICK()¢BYTE P,X1¢IF CFLAG=1 THEN¢ X1=PEEK(624)¢ Y1=PEEK(625)¢ IF X1<5 OR Y1<5 THEN¢ RETURN(0)¢ FI¢ X1=56+(X1/28)*16¢ Y1=36+(Y1/28)*16¢ IF ABS(X1,OLDX)<5 THEN¢ RETURN(0)¢ ELSEIF ABS(Y1,OLDY)<5 THEN¢ RETURN(0)¢ FI¢ X=X1¢ Y=Y1¢ RETURN(1)¢FI¢P=STICK(0)¢IF P=15 THEN¢ RETURN(0)¢FI¢IF P=11 AND OLDX>60 THEN¢ X=OLDX-16¢ RETURN(1)¢ELSEIF P=7 AND OLDX<180 THEN¢ X=OLDX+16¢ RETURN(1)¢ELSEIF P=14 AND OLDY>51 THEN¢ Y=OLDY-16¢ RETURN(1)¢ELSEIF P=13 AND OLDY<152 THEN¢ Y=OLDY+16¢ RETURN(1)¢FI¢RETURN(0)¢¢BYTE FUNC COMPLETE()¢BYTE J¢FOR J=1 TO COUNT-1 DO¢ IF USED(J)=0 THEN¢ RETURN(0)¢ FI¢OD¢RETURN(1)¢¢PROC NAME()¢BYTE J¢PUT(125)¢FOR J=TURN*10+1 TO TURN*10+10 DO¢ PUT(PLAYER(J))¢ IF PLAYER(J+1)=0 THEN¢ EXIT¢ FI¢OD¢PRINTE("'S TURN")¢RETURN¢¢PROC COLOR_IN(BYTE SPOT)¢BYTE K¢CARD K1¢IF B(SPOT)<>0 THEN¢ DO¢ UNTIL PICK_COLOR()<>0¢ OD¢ MOVE()¢ IF QUIT=1 THEN¢ RETURN¢ FI¢ X=OLDX¢ Y=OLDY¢ MOVE()¢ RETURN¢FI¢IF GOOD_COLOR(SPOT,COL)=0 THEN¢ BEEP()¢ PRINT("YOU CANNOT USE THAT")¢ PRINTE(" COLOR THERE")¢ BEEP()¢ RETURN¢FI¢COLOR=COL¢FILL_IN(SPOT)¢IF PLAYNUM=2 THEN¢ TURN==! 1¢FI¢NAME()¢FOR K1=1 TO 2000 DO¢OD¢RETURN¢¢PROC SHAPES()¢BYTE A,SPOT,J¢DO¢ TITLE()¢ GRAPHICS(8)¢ QUIT=0¢ PMGRAPHICS(1)¢ SETUP()¢ POKE(705,22)¢ POKE(623,160)¢ PMCLEAR(1)¢ MAKEPM(STAR,14,1,2,156,126)¢ X=56¢ Y=36¢ OLDX=0¢ OLDY=0¢ MOVE()¢ COLOR=3¢ COL=3¢ GRID()¢ TURN=0¢ SEARCH()¢ CHECK_BOARD()¢ INIT()¢ NAME()¢ DO¢ IF TRIGGER()=0 THEN¢ COLOR_IN(SPOT)¢ FI¢ IF JOYSTICK()=1 THEN¢ MOVE()¢ FI¢ SPOT=(X-38)/16+10*(Y-36)/16¢ UNTIL COMPLETE()=1 OR QUIT=1¢ OD¢ IF COMPLETE()=1 THEN¢ FOR J=TURN*10+1 TO TURN*10+10 DO¢ PUT(PLAYER(J))¢ IF PLAYER(J+1)=0 THEN¢ EXIT¢ FI¢ OD¢ PRINTE(" IS THE WINNER")¢ FI¢ PRINTE("PLAY AGAIN?")¢ A=INPUTB()¢ UNTIL A='N¢OD¢RETURN¢¢