PROGRAM PHASOR C L. R. FORTNEY 1/31/81 on a Z80 C Working on Atari 10/9/87 C This program draws two rotating phasors on the complex plane and C displays their x-projection as the phasors rotate. The amplitude C and frequency of one phasor is adjustable using the arrow keys. The C projected display can be of both phasors separately or of their summed C signal. Useful for showing beats. C Works only on hi-res mono displays. C PARAMETER (KEYLA=Z'004B0000',KEYRA=Z'004D0000', 1 KEYUA=Z'00480000',KEYDA=Z'00500000', 2 KEYTAB=Z'000F0009',KEYCR=Z'001C000D') INTEGER*1 BTFLAG,BMASK DIMENSION SN(256),CN(256) DATA TVMULT,MASK,BMASK/1.0,Z'FF',Z'FF'/ C C DEVELOP SIN COS LISTS C SHOW INSTRUCTIONS WRITE(9,1000) 1000 FORMAT(' CONTROL KEYS ARE:'/' TAB = INCREMENT MODE'/ 1 ' NUMBER KEY = SET MODE'/ 2 ' CR = EXIT PROGRAM'/' OTHER KEY = PAUSE/RESTART') WRITE(9,1002) 1002 FORMAT(//' MODES ARE: 0,1,2,3,0,1 ETC.'/ 1 ' 0=TWO PHASORS AROUND ORIGIN'/' 1=TWO PHASORS SUMMED'/ 2 ' 2=TWO AND SUM'/' 3=SUM ONLY'//) WRITE(9,1003) 1003 FORMAT(' MAGNITUDE AND FREQUENCY OF INNER PHASOR CHANGEABLE'/ 1 /' USING ARROW KEYS: LEFT,RIGHT FOR MAG UP,DOWN FOR FREQ'// 2 ' CR TO CONTINUE') C PAUSE C CALL RESETS C DO 50 I=1,64 ANG=(I-1)*0.024544 S=SIN(ANG) C=COS(ANG) SN(I)=S CN(I)=C SN(I+64)=C CN(I+64)=-S SN(I+128)=-S CN(I+128)=-C SN(I+192)=-C CN(I+192)=S 50 CONTINUE C C SIN COS LIST HAS FULL CIRCLE IN 256 INC. 100 AL=80.0 DAL=5.0 LAL=AL BL=70.0 LBL=BL WA=1.5 DWA=0.2 WB=2.0 IAX=400 IAY=280 LOOP=0 MODE=0 C 200 CALL CLEARS C CLEAR VECTOR DRAWN FLAGS IN ARROW SUBROUTINE CALL EARROW(11) C STOP VECTOR DRAWING ON FIRST POINT IASAVE=9999 IBSAVE=9999 ISSAVE=9999 C TITLE THE PLOT CALL SCTEXT(4,140,383,'PHASORS') CALL COMPR(136,379,228,395) C ADD AUTHOR INFO CALL SCTEXT(0,100,1, 1 'L. R. Fortney, Physics Dept, Duke Univ., Genie:DUKEL') C C RESTART HERE AFTER FULL CIRCLE C DRAW AXIES IXL=IAX-150 IXR=IAX+150 CALL PLOTP(IXL,IAY) CALL PLOTV(IXR,IAY) IY=IAY-50 CALL PLOTP(IAX,IY) CALL PLOTV(IAX,399) CALL SCTEXT(4,IAX+100,IAY-23,'REAL') CALL COMPR(IAX+95,IAY-26,IAX+150,IAY-10) CALL SCTEXT(6,IAX-8,320,'IMAG') CALL COMPR(IAX-20,318,IAX-4,364) C CALL PLOTP(30,0) CALL PLOTV(30,399) CALL SCTEXT(6,20,50,'Projection on real axis') CALL COMPR(4,48,26,328) C KIN=KEY(ISTAT) C CALL CARROW(4) CALL PLOTP(30,150) CALL PLOTV(599,150) CALL CARROW(5) CALL PLOTP(IAX,IAY) CALL PLOTV(IXR,IAY) CALL CARROW(6) CALL SCTEXT(4,440,123,'time') CALL COMPR(438,120,492,136) C C START MOVEMENT A=0.0 B=0.0 IT=30 BTFLAG=0 C CONTINUE MOVEMENT AFTER MODE CHANGE 300 A=A+WA B=B+WB IA=A IB=B BTFLAG=BTFLAG.XOR.BMASK IF(BTFLAG.EQ.0) IT=IT+1 IA=1+((IA-1).AND.MASK) IB=1+((IB-1).AND.MASK) IXA=AL*CN(IA)*TVMULT IYA=AL*SN(IA) LAL=SQRT(FLOAT(IXA**2)+FLOAT(IYA**2)) IXB=BL*CN(IB)*TVMULT IYB=BL*SN(IB) LBL=SQRT(FLOAT(IXB**2)+FLOAT(IYB**2)) IXS=IXA+IXB IYS=IYA+IYB IF(BTFLAG.EQ.0) GO TO 530 IF(IT.GT.599) GO TO 530 C PLOT ONLY IF IN SEPERATE MODE 510 IF(MODE.EQ.0) THEN IXAPLOT=IXA+150 CALL PLOTP(IT,IXAPLOT) IF(IASAVE.NE.9999) CALL PLOTV(IT-1,IASAVE) IASAVE=IXAPLOT C IXBPLOT=IXB+150 CALL PLOTP(IT,IXBPLOT) IF(IBSAVE.NE.9999) CALL PLOTV(IT-1,IBSAVE) IBSAVE=IXBPLOT ELSE C PLOT ONLY IN SUMMED MODE IXSPLOT=IXS+150 CALL PLOTP(IT,IXSPLOT) IF(ISSAVE.NE.9999) CALL PLOTV(IT-1,ISSAVE) ISSAVE=IXSPLOT ENDIF C C NOW READY TO PLOT THIS INSTANT 530 JAX=IAX+IXA JAY=IAY+IYA IF(MODE.GE.3) GO TO 540 CALL CARROW(4) CALL ARROW(4,IAX,IAY,LAL,JAX,JAY) 540 IBX=IAX+IXA IBY=IAY+IYA JBX=IAX+IXS JBY=IAY+IYS IF(MODE.NE.0) GO TO 550 CALL CARROW(5) IX=IXB+IAX IY=IYB+IAY CALL ARROW(5,IAX,IAY,LBL,IX,IY) GO TO 600 C 550 IF(MODE.NE.1 .AND. MODE.NE.2) GO TO 560 CALL CARROW(5) CALL ARROW(5,IBX,IBY,LBL,JBX,JBY) 560 IF(MODE.LT.2) GO TO 600 LCL=SQRT(FLOAT(IXS**2) +FLOAT(IYS**2)) CALL CARROW(6) CALL ARROW(6,IAX,IAY,LCL,JBX,JBY) C C TEST KEYBOARD WITHIN MAIN LOOP 600 KIN=KEY(ISTAT) IF(ISTAT.EQ.0) GO TO 800 C SELECT CASE(KIN) CASE (KEYLA) C LEFT ARROW REDUCES A MAGNITUDE AL=AL-DAL IF(AL.LT.10.0) AL=10.0 LAL=AL CASE (KEYTAB) C TAB CHANGES MODE MODE=(MODE+1).AND.3 DO (I=4,6) CALL CARROW(I) ENDDO IF(MODE.EQ.0) GO TO 200 CASE (KEYDA) C DOWN ARROW REDUCES WA (A FREQ) WA=WA-DWA IF(WA.LT.1.0) WA=1.0 CASE (KEYUA) C UP ARROW INCREASES WA WA=WA+DWA IF(WA.GT.10.0) WA=10.0 CASE (KEYRA) C RIGHT ARROW INCREASES A MAGNITUDE AL=AL+DAL IF(AL.GT.100.0) AL=100.0 LAL=AL CASE (KEYCR) C CR EXITS THE PROGRAM GO TO 999 CASE DEFAULT C CHECK FOR NUMBER KEY 0-3 TO SET MODE IF((KIN.AND.Z'000000F0').NE.Z'30') GO TO 690 KEYM=KIN.AND.Z'0000000F' IF(KEYM.GT.3) GO TO 690 MODE=KEYM DO (I=4,6) CALL CARROW(I) ENDDO IF(MODE.EQ.0) GO TO 200 GO TO 800 END SELECT GO TO 300 C OTHER KEY PAUSES AND WAITS FOR SECOND KEY 690 KIN=KEY(ISTAT) IF(ISTAT.EQ.0) GO TO 690 C 800 IF(IT.LT.599) GO TO 300 GO TO 200 C 999 END C SUBROUTINE ARROW(K,IX,IY,LNG,IXE,IYE) COMMON /ARRPTS/ ISTATE(10),IKX(4,10),IKY(4,10) C C ERASE AN OLD ARROW WITH EARROW(K) C DRAW NEW ARROW C USE "1"OR"2" AS INDEX FOR ARROWS WITH C SMALL ARROWHEADS. USE "3" FOR ARROW WITH C LARGE ARROWHEAD. "4"-"10" FOR ARROWHEADS C PROPORTIONAL TO LENGTH OF ARROW. IF(K.GT.0 .AND. K.LE.10) GO TO 60 WRITE(9,1000) 1000 FORMAT(10X,'PARAMETER FOR ARROW IS TOO LARGE') GO TO 999 C 60 ISTATE(K)=1 IDX=IX-IXE IDY=IY-IYE C THESE SIN COS POINT FROM END TO START LONG=LNG IF(LONG.LE.0) LONG=1 ICN=(60*IDX)/LONG ISN=(60*IDY)/LONG IKX(4,K)=IXE IKY(4,K)=IYE IKX(1,K)=IX IKY(1,K)=IY ICUT=LNG/20 IF(ICUT.LT.5) ICUT=5 IF(ICUT.GT.7) ICUT=7 ICNS=25*ICN ICNC=25*ICN ISNS=25*ISN ISNC=25*ISN IAX1=((ICNC +ISNS)*ICUT)/3000 IAY1=((ISNC -ICNS)*ICUT)/3000 IAX2=((ICNC -ISNS)*ICUT)/3000 IAY2=((ISNC +ICNS)*ICUT)/3000 IKX(2,K)=IXE +IAX1 IKY(2,K)=IYE +IAY1 IKX(3,K)=IXE +IAX2 IKY(3,K)=IYE +IAY2 C DO 240 I=1,3 CALL COMPP(IXE,IYE) IXP=IKX(I,K) IYP=IKY(I,K) CALL COMPV(IXP,IYP) 240 CONTINUE 999 RETURN END C C SUBROUTINE EARROW(KV) C ERASE DISPLAY FOR ARROW COMMON /ARRPTS/ ISTATE(10),IKX(4,10),IKY(4,10) C C KV=0 WILL CLEAR ALL STATE FLAGS C KV.GT.10 WILL CLEAR ALL FLAGS AND ERASE ALL VECTORS K=KV IF(K.GT.0 .AND. K.LE.10) GO TO 50 DO 8 I=1,10 8 ISTATE(I)=0 C IF(K.LE.0) GO TO 90 DO 30 K=1,10 ISTATE(K)=0 DO 30 I=1,3 CALL ERASP(IKX(4,K),IKY(4,K)) 30 CALL ERASV(IKX(I,K),IKY(I,K)) GO TO 90 C 50 DO 60 I=1,3 CALL ERASP(IKX(4,K),IKY(4,K)) 60 CALL ERASV(IKX(I,K),IKY(I,K)) 90 RETURN END C C SUBROUTINE CARROW(K) C COMPLEMENT DISPLAY FOR ARROW COMMON /ARRPTS/ ISTATE(10),IKX(4,10),IKY(4,10) IF(K.LT.1 .OR. K.GT.10) GO TO 90 IF(ISTATE(K).EQ.0) GO TO 90 ISTATE(K)=0 C DO 20 I=1,3 CALL COMPP(IKX(4,K),IKY(4,K)) 20 CALL COMPV(IKX(I,K),IKY(I,K)) 90 RETURN END C C FUNCTION KEY(ISTAT) C READ KEYBOARD WITH NO HANG C ISTAT=0 AND KEY=-1 IF NO CHARACTER AVAILABLE TO RETURN C OTHERWISE C ISTAT=-1 AND LOW BYTE OF KEY CONTAINS ASCII CODE include \lib\includes\gemdos.inc integer*4 atari ISTAT=atari(Cconis) IF(ISTAT.EQ.0) THEN KEY=-1 RETURN ENDIF KEY=atari(Cnecin) RETURN END