G0M 69 ACCEL@SRC AP$@@TH@@ ARINITSRC BOUND@DAT CHMASTSRC CHOR1@JOB CHOR1@SRC CHOR2@JOB CHOR2@SRC CHOR3@SRC CHRMN@SRC CLOSE@CTE COLM@@LST COLM@@SRC CONVRTSRC COPEE@JOB COPY@@JOB CTEST@JOB CTEST@SRC DANC1@SRC DANC2@SRC DANC3@SRC DANC4@SRC DANC5@SRC DANC6@SRC DATA@@SRC DIRECTJOB DRAWITSRC EDITD@SRC ERASE@SRC FILMODSRC FLUSH1JOB FLXDANSRC INCREMSRC INITL@SRC INPUTSSRC LOAD@@JOB MAIN@@SRC MOVINCSRC NEXT@@SRC NORMALSRC OCHRMNSRC ODRAWISRC OPEN@@COM PHASE2SRC POINT@DAT PRINT@JOB PRTPRDSRC PRTSUMSRC RDCON@SRC RDCONVSRC ROTATESRC RUN1@@JOB SAV@@@SRC SCHOR1SRC SCHOR2SRC SCOLM@SRC SORTB@SRC SRDCONSRC SSORTBSRC SYMBINSRC SYMBL@JOB SYMBLDSRC TBLD@@SRC TEST@@SRC TRAN@@SRC USR/P2EDT VARI0@DAT XTEST@SRC [\]. ACCEL@SRC SUBROUTINE ACCEL C SUBROUTINE TO HANDLE JUMPS C (NOT CODED YET) RETURN END [\]. AP$@@TH@@ C****** CHOR1 MAINLINE FOR CHOREO INTERACTIVE DANCE FACILITY** C****** AUTHOR G. A. MCDOUGALL ******************************* REAL ARR(4,32),CLEN(11),SHPAR(2,11,13),SUPLAR(4,6,2) REAL SUPTAR(4,17),TBAR(50,8),TCLEN(11),LEN,POS REAL XMIN,XMAX,YMIN,YMAX,XA,XB,YA,YB,FLXAR(4,7) REAL BPB,EBAR9,EDAN9,TX,TY,FEXT INTEGER COL,SUP,DIR,LEV,ROT,FLX,ENDOF,CHG,X,Y,XC,YC INTEGER BAR,CONT,FIRST,FLIP,I,INT,IVECT(500) INTEGER LAST,IOT,IOP,STP,SIB INTEGER SORTV1(50),SORTV2(50),ZXY(3),IEV,FNM(3) INTEGER TAG,MODE,BEGIN,END INTEGER RECS,IV,ADJ,DEL COMMON/SYMBOL/ COL,SUP,DIR,LEV,ROT,FLX,LEN,POS,TX,TY COMMON/ARRAY/ ARR,SHPAR,FLXAR,SUPLAR,SUPTAR COMMON/SORTC/SORTV1,SORTV2,SIB COMMON/VECT/ IVECT,FIRST,LAST,TAG,MODE,BEGIN,END COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX COMMON/FRAME/ XA,XB,YA,YB COMMON/IOLU/ IOT,IOP C****** DATA FNM(3),FEXT/1H1 ,3HSRC/ DATA CLEN,TCLEN/11*0.0,11*0.0/ IOT = 4 IOP=16 IOD = 15 WRITE (IOT,10) WRITE (IOT,11) 10 FORMAT(' USING CHOREO YOU MAY CREATE OR CHANGE A DANCE') 11 FORMAT(' DO YOU WISH TO CREATE A DANCE?(1/0)') READ (IOT,) SW1 WRITE (IOT,20) 20 FORMAT(' ENTER 4 CHAR. (NEW/OLD) DANCE NAME') READ (IOT,21) FNM(1),FNM(2) 21 FORMAT(2A2) CALL DELETE (15,5HDANC1,3HSRC,IEV) 25 CALL WAITFR (IEV) IF (IEV) 999,25,26 26 CALL ENTER (15,5HDANC1,3HSRC,IEV) 22 CALL WAITFR (IEV) IF (IEV) 999,22,23 23 WRITE (IOT,15) 15 FORMAT(' ENTER BEATS PER BAR (3 OR 4) ') READ (IOT,) BPB IF (SW1.NE.0) GOTO 60 CALL EDITD GOTO 1000 60 CALL ARINIT EBAR9 = 999 EDAN9 = 999 ZR = 0 BAR = 1 SIB = 0 WRITE (IOT,65) 65 FORMAT (' YOU MAY NOW ENTER SYMBOLS USING THE ACOUSTIC TABLET') C****** ESTABLISH SCREEN LIMITS XMIN = 0 XMAX = 20 YMIN = 0 YMAX = 20 C************************************************************* 80 CALL CLEAR(.TRUE.) CALL COLM 81 COL=0 SUP = 0 DIR = 0 LEV = 0 ROT = 0 FLX = 0 LEN = 0.0 POS = 0.0 CHG = 0 SIB = SIB +1 90 READ (IOT,) X,Y C90 CALL GETBLT(25,1,ZXY,IEV) C CALL WAITFR(IEV) C IF (ZXY(1).NE.0) GOTO 90 C XC=ZXY(3) C YC=ZXY(2) C X=17-XC/56 C Y=1+YC/56 C IF ((X.GT.16).OR.(Y.GT.16)) GOTO 90 C WRITE (IOT,) X,Y GOTO (90,100,90,110,90,120,90,130,140,150,90,160,90, * 170,180,90),X 100 IF ((Y.EQ.1).OR.(Y.GE.13)) GOTO 90 COL=Y-1 GOTO 90 110 IF ((Y.EQ.1).OR.(Y.EQ.16)) GOTO 90 SUP=Y-1 GOTO 90 120 IF((Y.EQ.1).OR.(Y.GE.15)) GOTO 90 DIR=Y-1 GOTO 90 130 GOTO (90,131,131,131,90,90,90,90,132,133,134,90,90, * 90,90,90),Y 131 LEV=Y-1 GOTO 90 132 ROT=8 GOTO 90 133 ROT=1 GOTO 90 134 ROT=2 GOTO 90 140 IF (Y.EQ.9) GOTO 143 IF (Y.EQ.11) GOTO 144 GOTO 90 143 ROT=7 GOTO 90 144 ROT=3 GOTO 90 150 GOTO (90,151,151,151,151,151,151,90,152,153,154,90,90, * 90,90,90),Y 151 FLX=Y-1 GOTO 90 152 ROT=6 GOTO 90 153 ROT=5 GOTO 90 154 ROT=4 GOTO 90 160 GOTO (90,161,161,161,161,161,161,161,161,90,90,200,90, * 300,90,1000),Y 161 LEN=LEN+(Y-1)*.125 IF (LEN.GT.BPB) LEN=BPB GOTO 90 C****** EDIT SECTION NOT CODED YET 170 GOTO 90 C****** EDIT AND REPLAY ARE NOT CODED YET 180 GOTO 90 C****** END OF SYMBOL *********************************************** 200 CONTINUE IF (COL.NE.0) GOTO 204 WRITE (IOT,201) 201 FORMAT(' DON''T FORGET TO ENTER THE COLUMN ') GOTO 90 204 IF (.NOT.((DIR.NE.0).AND.((LEN.EQ.0).OR.(LEV.EQ.0)))) GOTO 206 WRITE (IOT,205) 205 FORMAT(' WHEN A DIRECTION SYMBOL IS ENTERED ,LEN & LEV ARE REQD') GOTO 90 206 TX = 2.8 + 1.5 * (COL-1) TY = 2.0 + CLEN (COL) * 4 TAG=SIB WRITE(IOP,91) COL,SUP,DIR,LEV,ROT,FLX,LEN,POS 91 FORMAT(6I3,2F7.2) WRITE (IOP,) CLEN(COL) CALL SYMBLD POS = CLEN(COL) + TCLEN(COL) CLEN(COL) = CLEN(COL) + LEN WRITE (IOP,) POS,CLEN(COL) SORTV1(SIB) = (POS*1000)+COL TBAR(SIB,1) = FLOAT(COL) TBAR(SIB,2) = FLOAT(SUP) TBAR(SIB,3) = FLOAT(DIR) TBAR(SIB,4) = FLOAT(LEV) TBAR(SIB,5) = FLOAT(ROT) TBAR(SIB,6) = FLOAT(FLX) TBAR(SIB,7) = LEN TBAR(SIB,8) = POS GOTO 81 C****** END OF BAR ***************************************************** 300 SIB = SIB - 1 DO 310 I=1,11 TCLEN(I) = TCLEN(I)+BPB CLEN(I) = AMAX1(0.0,(CLEN(I)-BPB)) 310 CONTINUE WRITE (IOP,) (SORTV1(I),I=1,SIB) CALL SORTB ABAR = FLOAT(BAR) WRITE (IOP,) (SORTV2(I) ,I=1,SIB) ASIB = FLOAT(SIB) WRITE (IOD,330) EBAR9,ABAR,ASIB,ZR,ZR,ZR,ZR,ZR 330 FORMAT(6F5.0,2F7.3) DO 320 I=1,SIB IN = SORTV2(I) WRITE (IOD,330) (TBAR(IN,J),J=1,8) 320 CONTINUE TSIB = TSIB + SIB SIB = 1 BAR = BAR + 1 GOTO 80 C****** END OF DANCE ******************************************************* 999 CALL CLOSE (15,5HDANC1,3HSRC,IEV) 1000 WRITE (IOD,330) EDAN9,BAR,TSIB,ZR,ZR,ZR,ZR,ZR WRITE (IOT,) IEV STOP END [\]. ARINITSRC SUBROUTINE ARINIT C****** INITS ARRAYS FOR SYMBOLS -SHAPE,FLEXION,LEG SUP,TORS SUPP C REAL A,B,C,D,FLXAR(4,7),INC,SUPLAR(4,6,2),ARR(4,32) REAL SHPAR(2,11,13),SUPTAR(4,17),STEP,GEN(10) C COMMON/ARRAY/ ARR,SHPAR,FLXAR,SUPLAR,SUPTAR COMMON/IOLU/ IOT,IOP,IOD C DATA GEN/.2,.4,.6,.8,.8,.6,.4,.2,.2,.4/ C***** INITIALIZE SYMBOL SHAPE LINES ARRAYS STEP = 0.0 DO 10 I=1,11 IF (I.GT.5) STEP=.5 INC=.05*(I-1) SHPAR(1,I,1)=.0 SHPAR(2,I,1)=1.0 SHPAR(1,I,2)=.5-INC SHPAR(2,I,2)=.5+INC SHPAR(1,I,3)=INC SHPAR(2,I,3)=1.0-INC SHPAR(1,I,4)=.0 SHPAR(2,I,4)=.5+STEP SHPAR(1,I,5)=.0 SHPAR(2,I,5)=1.0-STEP SHPAR(1,I,6)=.5-STEP SHPAR(2,I,6)=1.0 SHPAR(1,I,7)=STEP SHPAR(2,I,7)=1.0 SHPAR(1,I,8)=.0 SHPAR(2,I,8)=1.0-INC SHPAR(1,I,9)=.0 SHPAR(2,I,9)=.5+INC SHPAR(1,I,10)=INC SHPAR(2,I,10)=1.0 SHPAR(1,I,11)=.5-INC SHPAR(2,I,11)=1.0 SHPAR(1,I,12)=.5-INC SHPAR(2,I,12)=1.0-INC SHPAR(1,I,13)=INC SHPAR(2,I,13)=.5+INC 10 CONTINUE C***** INITIALIZE SYMBOL FLEXION LINES ARRAY FLXAR(1,1)=.0 FLXAR(2,1)=.0 FLXAR(3,1)=1.0 FLXAR(4,1)=.0 STEP=.0 DO 20 I=2,7 IF (I.GT.4) STEP = .166 FLXAR(1,I)=.166*(I-1)-STEP FLXAR(2,I)=.0 FLXAR(3,I)=.166*(I-2)+STEP FLXAR(4,I)=.165 20 CONTINUE C***** INITIALIZE SYMBOL SUPPORT LINES ARRAY C****** LIMBS SUPLAR(1,1,1)=1.0 SUPLAR(1,1,2)=1.0 SUPLAR(2,1,1)=.2 SUPLAR(2,1,2)=.0 SUPLAR(3,1,1)=1.0 SUPLAR(3,1,2)=1.0 SUPLAR(4,1,1)=1.0 SUPLAR(4,1,2)=1.0 SUPLAR(1,2,1)=1.0 SUPLAR(1,2,2)=1.0 SUPLAR(2,2,1)=1.0 SUPLAR(2,2,2)=.7 SUPLAR(3,2,1)=.5 SUPLAR(3,2,2)=.5 SUPLAR(4,2,1)=.8 SUPLAR(4,2,2)=.7 SUPLAR(1,3,1)=1.0 SUPLAR(1,3,2)=1.0 SUPLAR(2,3,1)=.2 SUPLAR(2,3,2)=.3 SUPLAR(3,3,1)=.5 SUPLAR(3,3,2)=.5 SUPLAR(4,3,1)=.0 SUPLAR(4,3,2)=.3 DO 40 I=4,6 SUPLAR(1,I,1)=1.0 SUPLAR(2,I,1)=(I-2)*.2 SUPLAR(3,I,1)=.5 SUPLAR(4,I,1)=(I-3)*.2 SUPLAR(1,I,2)=1.0 SUPLAR(2,I,2)=.1+(I-4)*.4 SUPLAR(3,I,2)=.5 SUPLAR(4,I,2)=.1+(I-4)*.4 40 CONTINUE C****** TORSO B=.0 DO 50 I=1,4 A=0 IF ((I.EQ.2).OR.(I.EQ.3)) A=1. IF (I.EQ.3) B=1.0 C = 0.0 IF ((I.EQ.1).OR.(I.EQ.2)) C=1.0 SUPTAR(1,I)=A SUPTAR(2,I)=B SUPTAR(3,I)=C SUPTAR(4,I)=A 50 CONTINUE C = .4 D = .2 DO 60 I=5,12 A=C B=D C=GEN(I-2) D=GEN(I-4) SUPTAR(1,I)=A SUPTAR(2,I)=B SUPTAR(3,I)=C SUPTAR(4,I)=D 60 CONTINUE DO 70 I=13,17 INC=.0 IF ((I.EQ.13).OR.(I.EQ.17)) INC=.1 SUPTAR(1,I)=.1*(I-10) SUPTAR(2,I)=.2+INC SUPTAR(3,I)=.1*(I-10) SUPTAR(4,I)=.8-INC 70 CONTINUE C WRITE(IOP,) (((SHPAR(I,J,K),I=1,2),J=1,11),K=1,13) C WRITE(IOP,) ((FLXAR(I,J),I=1,4),J=1,7) C WRITE(IOP,) ((SUPTAR(I,J),I=1,4),J=1,17) C WRITE(IOP,) (((SUPLAR(I,J,K),I=1,4),J=1,6),K=1,2) RETURN END [\]. BOUND@DAT 0.8600000E+03 0.4120000E+04 0.8600000E+03 0.4380000E+04 0.8600000E+03 0.4530000E+04 0.8600000E+03 0.4720000E+04 0.8600000E+03 0.4940000E+04 0.8600000E+03 0.5150000E+04 0.8600000E+03 0.5380000E+04 0.8600000E+03 0.5590000E+04 0.8600000E+03 0.5810000E+04 0.8600000E+03 0.5980000E+04 0.8600000E+03 0.6050000E+04 0.8600000E+03 0.6200000E+04 0.8600000E+03 0.6410000E+04 0.1500000E+04 0.6550000E+04 0.2120000E+04 0.6600000E+04 0.2620000E+04 0.6550000E+04 0.2980000E+04 0.6510000E+04 0.3440000E+04 0.6630000E+04 0.3860000E+04 0.6770000E+04 0.4150000E+04 0.6780000E+04 0.4440000E+04 0.6810000E+04 0.4710000E+04 0.6840000E+04 0.4890000E+04 0.7000000E+04 0.5070000E+04 0.7150000E+04 0.5170000E+04 0.7070000E+04 0.5260000E+04 0.7020000E+04 0.5330000E+04 0.6960000E+04 0.5440000E+04 0.6930000E+04 0.5340000E+04 0.6770000E+04 0.5290000E+04 0.6570000E+04 0.5750000E+04 0.6260000E+04 0.6730000E+04 0.5830000E+04 0.8440000E+04 0.5660000E+04 0.1005000E+05 0.5570000E+04 0.1208000E+05 0.4520000E+04 0.1370000E+05 0.3620000E+04 0.1356000E+05 0.3400000E+04 0.1351000E+05 0.3330000E+04 0.1322000E+05 0.2890000E+04 0.1298000E+05 0.2500000E+04 0.1292000E+05 0.2420000E+04 0.1236000E+05 0.1540000E+04 0.1214000E+05 0.1240000E+04 0.1199000E+05 0.1050000E+04 0.1175000E+05 0.7200000E+03 0.1154000E+05 0.3900000E+03 0.1149000E+05 0.3100000E+03 0.1146000E+05 0.2600000E+03 0.1041000E+05 0.1400000E+04 0.9010000E+04 0.2910000E+04 0.7910000E+04 0.3330000E+04 0.6360000E+04 0.3680000E+04 0.5750000E+04 0.3790000E+04 0.5290000E+04 0.3940000E+04 0.5130000E+04 0.3950000E+04 0.5010000E+04 0.3960000E+04 0.4880000E+04 0.4000000E+04 0.4710000E+04 0.4010000E+04 0.4440000E+04 0.4060000E+04 0.4150000E+04 0.4100000E+04 0.3860000E+04 0.4120000E+04 0.3440000E+04 0.4120000E+04 0.2980000E+04 0.4120000E+04 0.2620000E+04 0.4120000E+04 0.2120000E+04 0.4120000E+04 0.1500000E+04 0.4120000E+04 0.5000000E+76 0.5000000E+76 0.5000000E+76 0.5000000E+76 [\]. CHMASTSRC C***************************************************************** C C THIS IS THE MASTER PROGRAM FOR ...CHOREO... AN INTERACTIVE C CHOREOGRAPHY APPLICATION BY RON NORDIN APRIL 1, 1974. C C THIS PROGRAM IS COMPOSED OF 4 STAGES C C***************************************************************** C C C***************************************************************** C C STAGE I - THIS IS AN INTERACTIVE STAGE IN WHICH MOVEMENT C INFORMATION IS BUILT UP IN A TABLE CALLED 'SYMTAB' C C***************************************************************** C C INTEGER SYMST1,SYMST2,SYMST3,BODYPT,MOVETP,SAVST3 DIMENSION BEATS(20) COMMON/EYCEP/EYE(3),CEN(3),UP(3) COMMON/OIL/IVECT(300) COMMON/LINKIT/ISTRT,LINKS(6,15) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX COMMON/MOTION/SYMTAB(5,7,20),DIRTAB(9,2) C DATA A,B/5HCHRME,4HNBIN/ DATA C,D/5HCHRMN,4HCBIN/ C C********** C LOAD THE 2 MENU FILES AND INITIALIZE VARIABLES C********** CALL CLEAR (.FALSE.) CALL ERRSET(1) CALL MENU(A,B,-1) CALL MENU(C,D,-1) XMAX=30. YMAX=20. YMIN=-40. XMIN=-30. ION = 4 IOFF = 5 C********** C --PUT UP TITLE PAGE. INTRP TO PROCEED.--- C CALL MENU(A,B,9) INTRP=10 5 IF(INTRP.EQ.0) GO TO 5 CALL MENU(A,B,10) C VECTOR TABLE-DIRTAB DIRTAB(1,1)=-1.0 DIRTAB(1,2)=0.00005 DIRTAB(2,1)=-.92 DIRTAB(2,2)=.37 DIRTAB(3,1)=-.7 DIRTAB(3,2)=.7 DIRTAB(4,1)=-.37 DIRTAB(4,2)=.92 DIRTAB(5,1)=0.00005 DIRTAB(5,2)=1.0 DIRTAB(6,1)=.37 DIRTAB(6,2)=.92 DIRTAB(7,1)=.7 DIRTAB(7,2)=.7 DIRTAB(8,1)=.92 DIRTAB(8,2)=.37 DIRTAB(9,1)=1.0 DIRTAB(9,2)=0.00005 C EYE POINT EYE(1)=0. EYE(2)=0. EYE(3)=60. CEN(1)=0. CEN(2)=0. CEN(3)=0. UP(1)=0. UP(2)=10. UP(3)=0. DIST=40. NEW=1 C C C********** C --3 IS THE TOP OF THE NEW DANCE LOOP---- C 3 CALL MENU(C,D,10) C SYMST3=1 SAVST3=1 EXFRAM=0.0 C --PLCE DANCER IN THE NORMAL POSITION--- C --SET NEW = 1 TO CALL ROTOR IN DRAWIT.-- CALL NORMAL(DIST,NEW) C C********** C --ENTER BEAT TEMPO--- TEMPO=8.0 C --CHECK IF NEW DANCE OR READ IN: NEW? GOTO 1. READ IN? 4 CALL MENU(C,D,1) CALL CRT(ION,401) CALL CRT(ION,402) 6 NUM=1 7 IF(NUM.EQ.-1) GO TO 7 IF(NUM.EQ.2) GO TO 1 IF(NUM.EQ.1)GO TO 4 GO TO 6 C C********** C READ IN DANCE MOVEMENT 4 CONTINUE DO 11 K=1,8 KCNT=K READ(8,9)BEATS(K) DO 8 J=1,7 8 READ(8,9)(SYMTAB(I,J,K),I=1,5) 9 FORMAT(5F7.2) IF(SYMTAB(5,7,K).EQ.9.) GO TO 12 11 CONTINUE C 12 SYMST3=KCNT C----GO AND GENERATE DISPLAY OF MOVEMENTS---- GO TO 949 C********************************************************* C C --START OF NEW POSITION LOOP----- 1 SYMST3= SYMST3 + 1 C C --START OF NEW BODY PART LOOP----- C 2 CALL MENU(C,D,10) CALL MENU(A,B,1) CALL CRT(ION,401) CALL CRT(ION,402) 10 NUM =-1 15 IF ( NUM .EQ. -1) GO TO 15 IF (NUM.GT.6 .OR.NUM.EQ.0) GO TO 10 IF (NUM.GE.3 .AND. NUM.LE.6) GO TO 200 C C***************************************************************** C HEAD AND TORSO MOVEMENT SELECTION BLOCK C***************************************************************** BODYPT = (NUM *10) + 6 SYMTAB (1,NUM,SYMST3) =1 SYMST2 = NUM C********** C CALL MENU PAGE 4 C********** 110 CALL MENU(A,B,2) CALL CRT(ION,401) CALL CRT(ION,402) CALL CRT(ION,BODYPT) 130 NUM = -1 INTRP = 0 135 IF (INTRP.EQ.-1) GO TO 800 IF (NUM.EQ.-1) GO TO 135 IF (NUM.EQ.4 .OR. NUM.EQ.5 .OR. NUM.EQ.9 .OR. NUM.EQ.0) GO TO 130 C C********** C IF EXTENTION OR FLEXION C********** IF (NUM.EQ.1) SYMST1 = 2 IF (NUM.EQ.6) SYMST1 =-2 C C********** C IF ROTATION IN OR ROTATION OUT C********** IF(NUM.EQ.3)SYMST1=4 IF (NUM.EQ.8) SYMST1 =-4 C C********** C IF INCLINATION LEFT OR INCLINATION RIGHT C********** IF (NUM.EQ.2) SYMST1 =-3 IF (NUM.EQ.7) SYMST1 = 3 C MOVETP = NUM * 100 GO TO 700 C C***************************************************************** C ARMS AND LEGS MOVEMENT SELECTION BLOCK C****************************************************************** 200 BODYPT = (NUM *10) + 6 SYMTAB(1,NUM,SYMST3) = 1 SYMST2 = NUM C********** C CALL MENU PAGE 5 C********** 210 CALL MENU(A,B,3) CALL CRT(ION,401) CALL CRT(ION,402) CALL CRT(ION,BODYPT) 220 NUM =-1 INTRP = 0 230 IF (INTRP.EQ.-1) GO TO 800 IF (NUM.EQ.-1) GO TO 230 IF(NUM.EQ.5 .OR. NUM.EQ.9 .OR. NUM.EQ.0) GO TO 220 IF (SYMST2.EQ.3 .OR. SYMST2.EQ.5) GO TO 250 C C********** C RIGHT ARM AND RIGHT LEG SELECTION C********** C C********** C IF IN DEPTH FRONT OR BACK C********** IF (NUM.EQ.1) SYMST1 = 2 IF (NUM.EQ.6) SYMST1 =-2 C C********** C IF ADDUCTION OR ABDUCTION C********** IF (NUM.EQ.2) SYMST1 = 3 IF (NUM.EQ.7) SYMST1 =-3 C C********** C IF ROTATION IN OR OUT C********** IF (NUM.EQ.3) SYMST1 =-4 IF (NUM.EQ.8) SYMST1 = 4 C C********** C IF FLEXION C********** IF (NUM.EQ.4 .AND. SYMST2.EQ.4) SYMST1 = 5 IF (NUM.EQ.4 .AND. SYMST2.EQ.6) SYMST1 =-5 C MOVETP = NUM * 1000 GO TO 700 C C********** C LFT ARM AND LEFT LEG SELECTION C********** 250 IF (NUM.EQ.1) SYMST1 = 2 IF (NUM.EQ.6) SYMST1 =-2 C IF (NUM.EQ.2) SYMST1 =-3 IF (NUM.EQ.7) SYMST1 = 3 C IF (NUM.EQ.3) SYMST1 = 4 IF (NUM.EQ.8) SYMST1 =-4 C IF (NUM.EQ.4 .AND. SYMST2.EQ.3) SYMST1 = 5 IF (NUM.EQ.4 .AND. SYMST2.EQ.5) SYMST1 =-5 C MOVETP = NUM * 1000 GO TO 700 C C****************************************************************** C MOVEMENT **DEGREE** SELECTION BLOCK C****************************************************************** C C********** C CALL MENU PAGE 6 C********** 700 CALL MENU(A,B,4) CALL CRT(ION,401) CALL CRT(ION,402) CALL CRT(ION,BODYPT) CALL CRT(ION,MOVETP) IF (SYMST2.EQ.5 .OR. SYMST2.EQ.6) GO TO 750 IF (SYMST2.EQ.3 .OR. SYMST2.EQ.4) GO TO 730 IF (SYMST2.EQ.2) GO TO 720 C C********** C HEAD MOVEMENT DEGREE SELECTION C********** 710 NUM =-1 711 IF (NUM.EQ.-1) GO TO 711 IF (MOVETP.EQ.100 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.200 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.300 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.600 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.700 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.800 .AND. NUM.LE.4) GO TO 755 GO TO 710 C C********** C TORSO MOVEMENT DEGREE SELECTION C********** 720 NUM =-1 721 IF (NUM.EQ.-1) GO TO 721 IF (MOVETP.EQ.100 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.200 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.300 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.600 .AND. NUM.LE.8) GO TO 755 IF (MOVETP.EQ.700 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.800 .AND. NUM.LE.4) GO TO 755 GO TO 720 C C********** C ARMS MOVEMENT DEGREE SELECTION C********** 730 NUM =-1 731 IF (NUM.EQ.-1) GO TO 731 IF (MOVETP.EQ.1000 .AND. NUM.LE.9) GO TO 755 IF (MOVETP.EQ.2000 .AND. NUM.LE.9) GO TO 755 IF (MOVETP.EQ.3000 .AND. NUM.LE.9) GO TO 755 IF (MOVETP.EQ.4000 .AND. NUM.LE.9) GO TO 755 IF (MOVETP.EQ.6000 .AND. NUM.LE.5) GO TO 755 IF (MOVETP.EQ.7000 .AND. NUM.LE.8) GO TO 755 IF (MOVETP.EQ.8000 .AND. NUM.LE.9) GO TO 755 GO TO 730 C C********** C LEGS MOVEMENT DEGREE SELECTION C********** 750 NUM =-1 751 IF (NUM.EQ.-1) GO TO 751 IF (MOVETP.EQ.1000 .AND. NUM.LE.9) GO TO 755 IF (MOVETP.EQ.2000 .AND. NUM.LE.5) GO TO 755 IF (MOVETP.EQ.3000 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.4000 .AND. NUM.LE.9) GO TO 755 IF (MOVETP.EQ.6000 .AND. NUM.LE.5) GO TO 755 IF (MOVETP.EQ.7000 .AND. NUM.LE.4) GO TO 755 IF (MOVETP.EQ.8000 .AND. NUM.LE.5) GO TO 755 GO TO 750 C C****************************************************************** C ADD TO SYMTAB TABLE C****************************************************************** 755 IF (SYMST1.LT.0) NUM =-NUM SYMST1 = IABS(SYMST1) SYMTAB(SYMST1,SYMST2,SYMST3) = NUM C********** C RETURN TO MOVEMENT TYPE SLECTION C********** IF (SYMST2.LE.2) GO TO 110 GO TO 210 C C****************************************************************** C NEW POSITION COMPLETE ? C****************************************************************** C C********** C CALL MENU PAGE 7 C********** 800 CALL MENU(A,B,6) CALL CRT(ION,401) CALL CRT(ION,402) 810 NUM =-1 811 IF (NUM.EQ.-1) GO TO 811 IF (NUM.GT.2 .OR. NUM.EQ.0) GO TO 810 IF (NUM.EQ. 2) GO TO 900 C GO TO 2 C C****************************************************************** C NEW BODY DIRECTION ? C 900 CALL MENU(A,B,7) CALL CRT(ION,401) CALL CRT(ION,402) C ---SELECT ORIENTATION----- 910 NUM =-1 INTRP=0 911 IF (INTRP.EQ.-1) GO TO 915 IF (NUM.EQ.-1) GO TO 911 IF (NUM.EQ.9 .OR. NUM.EQ.0) GO TO 910 SYMTAB(1,7,SYMST3)=1. SYMTAB(2,7,SYMST3) = NUM C C --SELECT DIRECTION OF ROTATION---- 912 NUM=-1 913 IF (NUM.EQ.-1) GO TO 913 IF (NUM.LT.9 .AND. NUM.NE.0) GO TO 912 SYMTAB(3,7,SYMST3) =NUM 915 CONTINUE C C ----CONVERT SYMTAB TO VECTOR,ROLL AND FLEXION----- CALL CONVRT(SYMST3) C::****************************************************** C C --ENTER NUMBER OF BEATS FOR THIS MOVEMENT. CALL MENU(A,B,10) CALL MENU(C,D,10) CALL MENU(C,D,5) CALL CRT(ION,401) CALL CRT(ION,402) C --WHOLE BEATS HERE-- NUM=-1 922 IF(NUM.EQ.-1)GO TO 922 BEATS(SYMST3)=NUM C C ---QUARTER BEATS HERE--- CALL MENU(C,D,6) CALL CRT(ION,401) CALL CRT(ION,402) 923 NUM=-1 924 IF(NUM.EQ.-1)GO TO 924 C --TRAP OUT ILLEGAL ENTRIES-- IF(NUM.EQ.0)GO TO 923 IF(NUM.GE.5)GO TO 923 C --TOTAL-- BEATS(SYMST3)=BEATS(SYMST3)+FLOAT(NUM-1)/4.0 C CALL MENU(A,B,10) CALL MENU(C,D,10) C****************************************************************** C --IS A PREVIEW REQUESTED?------ 949 CALL MENU(C,D,10) CALL MENU(A,B,8) CALL CRT(ION,401) CALL CRT(ION,402) 950 NUM=2 951 IF (NUM.EQ.-1) GO TO 951 IF (NUM.NE.1 .AND. NUM.NE.2) GO TO 950 IF (NUM.EQ.2) GO TO 999 C C INCREMENT TO THE NEXT NEW POSITION DEFINITION GO TO 1 C******************************************************************* C C --DISPLAY LOOP SECTION----- 999 CALL MENU(A,B,10) CALL MENU(C,D,10) C C*************** C MAIN DISPLAY LOOP ---- C 1000 SAVST3=SAVST3+1 C C --CALCULATE NO. STEPS FOR THIS MOVEMENT-- TOTFRM=BEATS(SAVST3)*TEMPO+EXFRAM ISTP=TOTFRM+0.5 EXFRAM=TOTFRM-FLOAT(ISTP) C C --GO GENERATE RAC MATRICES-- CALL GENRAC(SAVST3,ISTP,NEW,DIST) C --CHECK IF THIS IS THE LAST UNCALC. MOVEMENT-- IF (SAVST3.LT.SYMST3) GO TO 1000 C C****************************************************************** C FILM SECTION-------------------- IFM=1 1100 CALL DSPLAY(3,32767,IERR) CALL CLEAR CALL DSPLAY(1,32767,IERR) CALL PULSE(2,IFM) PAUSE IFM=IFM+10 IF(IFM.LT.111)GO TO 1100 C C C STAGE IV - INTERACTIVE STAGE OFFERING A FACILITY TO C SAVE THE DANCE DESCRIPTION. C C ---CONTINUE OR END----- CALL MENU(A,B,10) CALL MENU(C,D,2) CALL CRT(ION,401) CALL CRT(ION,402) 1253 NUM=-1 1255 IF(NUM.EQ.-1) GO TO 1255 IF (NUM.EQ.1) GO TO 1 IF(NUM.EQ.2) GO TO 1260 GO TO 1253 C C********** C CALL MENU PAGE 11 C********** 1260 CALL MENU(C,D,3) CALL CRT(ION,401) CALL CRT(ION,402) 1265 NUM=-1 1266 IF(NUM.EQ.-1) GO TO 1266 IF (NUM.EQ.1) GO TO 1270 IF(NUM.EQ.2)GO TO 1280 GO TO 1265 C 1270 SYMTAB(5,7,SYMST3)=9. DO 1274 K=1,SYMST3 WRITE(7,1275)BEATS(K) DO 1274 J=1,7 1274 WRITE(7,1275)(SYMTAB(I,J,K),I=1,5) 1275 FORMAT(1X,5F7.2) C C********** C CALL MENU PAGE 12 C********** 1280 CALL MENU(C,D,4) CALL CRT(ION,401) CALL CRT(ION,402) 1282 NUM=-1 1283 IF(NUM.EQ.-1)GO TO 1283 IF(NUM.EQ.1)GO TO 3 IF (NUM.EQ.2)GO TO 1290 GO TO 1282 C 1290 STOP 7 END [\]. CHOR1@JOB $JOB 21 T=5 UFD=RK1 $MSG CHOR1 -CHOR1 TKB STEP $DEL CHOR1 TSK $DEL CHOR1 IMG $TKB SZ,UL:F4LIB} CHOR1} 350} TDV.GR} CHOR1,ARINIT,COLM,SYMBLD,SORTB} } $CON CHOR1} $END $END $PAR TDV.GR [\]. CHOR1@SRC C **************************************************************** C CHOR1 (LABAN SYMBOL INPUT PHASE) FOR C *CHOREO* INTERACTIVE DANCE FACILITY (AUTHOR -G.A.MCDOUGALL) C -STORES EACH SYMBOL AS 8 NUMBERS IN "DANC1 SRC" FILE C -CALLS SYMBLD TO DISPLAY SYMBOL C -CALLS SORTB TO SORT SYMBOLS INTO READ ORDER C **************************************************************** C REAL BLEN,BTIM,SBTIM(11),TBAR(50,2) REAL XMIN,XMAX,YMIN,YMAX REAL XA,XB,YA,YB C INTEGER COL,SUP,DIR,LEV,ROT,FLX,CHG INTEGER X,Y,XC,YC INTEGER TBARI(50,6),EBAR,EDAN INTEGER BAR,CONT,FLIP INTEGER STP,SIB,TSIB,CH,ZR,FNM(2) INTEGER SORTV1(50),SORTV2(50),ZXY(3) INTEGER FIRST,LAST,TAG,MODE,BEGIN,END,IVECT(400) INTEGER INT,ISPACE,FNC INTEGER IOT,IOP,IOD C COMMON/SYMBOL/ COL,SUP,DIR,LEV,ROT,FLX,BLEN,BTIM,SBTIM COMMON/SORTC/SORTV1,SORTV2,SIB COMMON/VECT/ FIRST,LAST,TAG,MODE,BEGIN,END,IVECT COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX COMMON/FRAME/ XA,XB,YA,YB COMMON/IOLU/ IOT,IOP,IOD C DATA TBARI,TBAR/300*0,100*0./ C C INIT LUN ASST'S **************************************** IOT=4 IOP=6 IOD=17 C WRITE(IOT,9) WRITE (IOT,10) WRITE (IOT,11) C 9 FORMAT('- ******** CHOREO INTERACTIVE DANCE FACILITY *********') 10 FORMAT(' YOU MAY 1-CREATE,2-CHANGE THE CHOREO "DANC1 SRC" FILE') 11 FORMAT(' ENTER YOUR CHOICE AS A NUMBER') READ (IOT,) CH IF (CH .EQ.2) GOTO 28 C CREATE -DELETE OLD FILE (IF PRESENT) 23 CALL DELETE (IOD,5HDANC1,3HSRC,IEV) 25 CALL WAITFR (IEV) IF (IEV) 999,25,27 27 WRITE (IOT,15) C 15 FORMAT( ' ENTER BEATS/BAR (3 OR 4)') READ (IOT,) BPB C OPEN THE DANCE FILE 26 CALL ENTER (IOD,5HDANC1,3HSRC,IEV) 22 CALL WAITFR (IEV) IF (IEV) 999,22,60 C C CHANGE SYMBOLS IN EXISTING FILE 28 CONTINUE C CALL SEEK(IOD,5HDANC1,3HSRC,IEV) C CALL EDITD (NOT CODED YET) GOTO 1000 C INITIALIZATION SECTION ********************************** 60 CONTINUE C INIT SCREEN LIMITS XMIN=0. XMAX=20. YMIN=0. YMAX=20. XA=0. XB=20. YA=0. YB=20. C INITIALIZE ARRAYS USED TO BUILD SYMBOLS CALL ARINIT C INIT GEN PURPOSE VARS EBAR = 998 EDAN =999 ZR = 0 RZR=0. BAR = 1 SIB=0 TSIB=0 BBTIM=0. DO 64 I=1,11 64 SBTIM(I)=0.0 WRITE(IOT,65) C 65 FORMAT(' NOW -ENTER SYMBOLS FROM THE ACOUSTIC TABLET') C****************************************************************** C SYMBOL PARAMETER ASSIGNMENT SECTION 80 CONTINUE CALL CLEAR(.TRUE.) CALL COLM 81 COL=0 SUP = 0 DIR = 0 LEV = 0 ROT = 0 FLX = 0 BLEN = 0.0 BTIM = 0.0 GOTO 90 C ********************************* MANUAL INPUT SECTION ***** C90 WRITE (IOT,190) 190 FORMAT(' CO SU DI LE RO FL BL 1=EOS/2=EOB/3=EOD') READ (IOT,) COL,SUP,DIR,LEV,ROT,FLX,BLEN,III GOTO (200,300,1000),III GOTO 90 C ************************* A.T. INPUT SECTION ****************** 90 CALL GETBLT(25,0,ZXY,IEV) CALL WAITFR(IEV) XC=ZXY(3) YC=ZXY(2) X=17-XC/56 Y=1+YC/56 IF ((X.GT.16).OR.(Y.GT.16)) GOTO 90 C **************************************************************** C SET THE PARAMETER GOTO (90,100,90,110,90,120,90,130,140,150,90,160,90, * 170,180,90),X C SET ** COL ** 100 IF ((Y.EQ.1).OR.(Y.GE.13)) GOTO 90 COL=Y-1 WRITE (IOT,) COL GOTO 90 C SET ** SUP ** 110 IF (Y.EQ.16) GOTO 90 SUP=Y-1 WRITE (IOT,) SUP GOTO 90 C SET ** DIR ** 120 IF (Y.GE.15) GOTO 90 DIR=Y-1 WRITE (IOT,) DIR GOTO 90 C SET ** LEV OR ROT ** 130 GOTO (90,131,131,131,90,90,90,90,132,132,132,90,90, * 90,90,90),Y 131 LEV=Y-1 WRITE (IOT,) LEV GOTO 90 132 ROT=Y-2 IF (Y.EQ.11) ROT=1 WRITE (IOT,) ROT GOTO 90 C SET ** ROT ** 140 IF (Y.EQ.9) ROT=6 IF (Y.EQ.10) ROT=0 IF (Y.EQ.11) ROT=2 WRITE (IOT,) ROT GOTO 90 C SET ** FLX OR ROT ** 150 GOTO (151,151,151,151,151,151,151,90,152,152,152,90,90, * 90,90,90),Y 151 FLX=Y-1 WRITE (IOT,) FLX GOTO 90 152 ROT=5-(Y-9) WRITE (IOT,) ROT GOTO 90 C SET ** EOS, EOB, EOD ** 160 GOTO (161,161,161,161,161,161,161,161,161,90,90,200,90, * 300,90,1000),Y C SET ** BLEN ** 161 BLEN=BLEN+(Y-1)*.125 IF (BLEN.GT.BPB) BLEN=BPB IF (Y.EQ.1) BLEN=0 WRITE (IOT,) BLEN GOTO 90 C CHANGE SYMBOL (NOT CODED YET) 170 GOTO 90 C EDIT,REPLAY NOT CODED YET 180 GOTO 90 C *********************************************************** C SYMBOL ERROR MSGS 200 CONTINUE IF (COL .GT. 0) GOTO 204 WRITE (IOT,201) 201 FORMAT (' COL IS ALSO REQUIRED') GOTO 90 204 IF (.NOT.((DIR.NE.0).AND.((LEN.EQ.0).OR.(LEV.EQ.0)))) GOTO 206 WRITE(IOT,205) 205 FORMAT(' BLEN, LEV ARE ALSO REQUIRED') GOTO 90 C ***************************************************************** C SYMBOL DISPLAY & STORE SECTION 206 CONTINUE SIB=SIB+1 TAG=SIB C BUILD AND DISPLAY SYMBOL CALL SYMBLD C CALC SYMBOL START TIME (BEAT UNITS) BTIM=BBTIM+SBTIM(COL) WRITE (IOT,) BTIM,SIB C UPDATE RELATIVE (WRT BAR) START TIME SBTIM(COL)=SBTIM(COL)+BLEN C STORE SORT ORDER SORTV1(SIB) = (BTIM*1000)+COL C STORE SYMBOL IN TEMP ARRAY (MUST BE SORTED BEFORE FILED) TBARI(SIB,1) = COL TBARI(SIB,2) = SUP TBARI(SIB,3) = DIR TBARI(SIB,4) = LEV TBARI(SIB,5) = ROT TBARI(SIB,6) = FLX TBAR(SIB,1) = BLEN TBAR(SIB,2) = BTIM WRITE (IOT,208) 208 FORMAT('------------------ END OF SYMBOL ------------') GOTO 81 C************************************************************************ C END OF BAR PROCESSING 300 CONTINUE C SORT THE SYMBOLS BY COL WITHIN STARTING LOCATION CALL SORTB C FILE HEADER & SYMBOL RECORDS IN ORDER WRITE (IOD,500) EBAR,BAR,SIB,ZR,ZR,ZR,RZR,RZR 500 FORMAT(6I3,2F7.3) DO 320 I=1,SIB IN = SORTV2(I) WRITE (IOD,500) TBARI(IN,1),TBARI(IN,2),TBARI(IN,3),TBARI(IN,4), 1TBARI(IN,5),TBARI(IN,6),TBAR(IN,1),TBAR(IN,2) 320 CONTINUE C C UPDATE TOTAL SYMBOLS IN DANCE & BAR # , RESET SIB TSIB = TSIB + SIB SIB = 0 BAR = BAR + 1 C UPDATE ABSOLUTE BAR START TIME, & RELATIVE (WRT BAR) C SYMBOL START TIME BBTIM=BBTIM+BPB DO 310 I=1,11 310 SBTIM(I)=AMAX1(0.0,(SBTIM(I)-BPB)) WRITE (IOT,311) 311 FORMAT(' ***************** END OF BAR ****************') GOTO 80 C*************************************************************** C END OF DANCE PROCESSING 1000 WRITE (IOD,500) EDAN,BAR,TSIB,ZR,ZR,ZR,RZR,RZR C CLOSE THE DANCE FILE 999 CONTINUE CALL CLOSE (IOD,5HDANC1,3HSRC,IEV) CALL WAITFR(IEV) WRITE(IOT,)IEV 2000 CONTINUE WRITE(IOT,2001) C 2001 FORMAT(' TO VIEW ANIMATION OF DANCE -ENTER "CHOR2"') STOP END [\]. CHOR2@JOB $JOB 21 T=5 UFD=RK1 $MSG CHOR2: CHOREO BATCH JOB TO ASSEMBLE AND TASK BUILD CHOR2 TASK $FOR BRL_CHOR2,MOVINC,RDCON $FOR BRL_NORMAL,INITL,INPUTS,ROTATE,FILMOD,PRTPRD,PRTSUM,NEXT,DRAWIT $DEL CHOR2 TSK $DEL CHOR2 IMG $TKB SZ,UL:F4LIB} CHOR2} 350} TDV.GR} CHOR2,RDCON,MOVINC,NORMAL,INITL,INPUTS,ROTATE,FILMOD, PRTPRD,PRTSUM,NEXT,DRAWIT} } $CON CHOR2 $END [\]. CHOR2@SRC C------------------------------------------------------------------- C CHOR2 (ANIMATION PHASE) FOR *CHOREO* INTERACTIVE DANCE FACILITY C (AUTHOR: GLEN MCDOUGALL) C -CALLS RDCON TO READ "DANC1 SRC" FILE & CONVERT TO MODULE ANGLES C -COORDINATES TIMING FOR MODULE MOVEMENT C -CALLS MOVINC TO BUILD & DISPLAY EACH FRAME C -MODS 1-15=(HP,CH,RUA,RLA,RH,LUA,LLA,LH,HD,RUL,RLL,RF,LUL,LLL,LF) C---------------------------------------------------------------------- INTEGER FRMTIM,FTIM,FDUR1,FTIMN,FDURN INTEGER NFRMS(15) REAL LRPY,FANG(3,15) C COMMON/LRPYC/LRPY(6,15),LFRM COMMON/FANGC/FANG,FRMTIM,NFRMS COMMON/IOLU/ IOT,IOP,IOD COMMON/EYCEP/EYE(3),CEN(3),UP(3) COMMON/LINKIT/ ISTRT,LINKS(6,15) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX C****************************************************************** C TERMINAL & PRINTER LUN'S IOT=4 IOP=6 IOD=17 C SET UP VIEWING PARAMETERS XMIN=-30. XMAX=30. YMIN=-30. YMAX=30. C EYE(1)=0. EYE(2)=0. EYE(3)=0. CEN(1)=0. CEN(2)=0. CEN(3)=0. UP(1)=0. UP(2)=10. UP(3)=0. DIST=60. C 4 WRITE(IOT,5) 5 FORMAT(' ENTER VIEW: 1-BACK,2-FRONT,3-RSIDE,4-LSIDE,5-TOP') READ(IOT,) I IF((I.GT.5).OR.(I.LT.1)) GOTO 4 IF (I.EQ.1) EYE(1)= -DIST IF (I.EQ.2) EYE(1)= DIST IF (I.EQ.3) EYE(3)= DIST IF (I.EQ.4) EYE(3)= -DIST IF (I.NE.5) GOTO 7 EYE(2) = DIST EYE(1) = -DIST/6 7 CALL ROTER CALL CLEAR(.TRUE.) C***************************************************************** C INIT -FOR EACH MODULE:# OF MOVEMENT FRAMES C & LOCAL ROLL, PITCH, YAW ROTATIONS & FINAL ANGLES DO 21 M=1,15 DO 21 L=1,6 NFRMS(M)=0 LRPY(L,M)=0. IF (L.GT.3) GOTO 21 FANG(L,M)=0. 21 CONTINUE ISTRT=1 NEW=0 C READ IN MOD & LINK INFO & DISPLAY CHARLIE(AT ATTENTION) CALL INPUTS LFRM=1 CALL MOVINC(DIST,NEW) C WRITE(IOT,19) 19 FORMAT(' ENTER TEMPO (IN BEATS PER MIN.)') READ(IOT,)TMPO FPBT=1440./TMPO C INIT PARAMETERS JUMP=0 FRMTIM=0 C OPEN THE DANCE FILE FOR FUTURE READS CALL SEEK(IOD,5HDANC1,3HSRC,IEV) 22 CALL WAITFR(IEV) IF (IEV) 999,22,23 23 CONTINUE WRITE (IOT,) IEV,FPBT C*************************************************************************** C READ & CONVERT DANCE FILE SYMBOLS INTO MOD ANGLES 2 CONTINUE CALL RDCON (FPBT) WRITE (IOP,) FRMTIM,LFRM C END OF DANCE ? IF (FRMTIM.LT.0) GOTO 999 C CALC INCR ANGLES FOR NEW MOVEMENTS DO 15 MOD=1,15 FDUR1=NFRMS(MOD) IF (FDUR1.EQ.0) GOTO 15 LRPY(4,MOD)=(FANG(1,MOD)-LRPY(1,MOD))/FDUR1 LRPY(5,MOD)=(FANG(2,MOD)-LRPY(2,MOD))/FDUR1 LRPY(6,MOD)=(FANG(3,MOD)-LRPY(3,MOD))/FDUR1 15 CONTINUE C***************************************************************** DO 398 I=1,15 IF (NFRMS(I).EQ.0) GOTO 398 WRITE (IOP,) NFRMS(I) 398 CONTINUE DO 399 I=1,15 DO 399 J=1,6 IF (LRPY(J,I).EQ.0) GOTO 399 WRITE (IOP,) LRPY(J,I) 399 CONTINUE C***************************************************************** C DISPLAY CHARLIE FOR LFRM FRAMES C USING LRPY ANGLES C CALL MOVINC(DIST,NEW) C UPDATE FRMTIM ("ABSOLUTE CLOCK") FRMTIM=FRMTIM+LFRM C****************************************************************** C UPDATE START ANGLES AND # OF REMAINING FRAMES DO 11 M=1,15 C IF NO RECENT MOD MOVMNT -IGNORE IF (NFRMS(M).EQ.0) GOTO 11 C UPDATE START ANGS LRPY(1,M)=FANG(1,M) LRPY(2,M)=FANG(2,M) LRPY(3,M)=FANG(3,M) C UPDATE # REMAINING FRMS NFRMS(M)=NFRMS(M)-LFRM C IF MOD MOVMNT ENDS ZERO INCR ANGS FOR MOD IF (NFRMS(M).NE.0) GOTO 11 LRPY(4,M)=0. LRPY(5,M)=0. LRPY(6,M)=0. 11 CONTINUE C*************************************************************** DO 498 I=1,15 IF (NFRMS(I) .EQ.0) GOTO 498 WRITE (IOP,) NFRMS(I) 498 CONTINUE DO 499 I=1,15 DO 499 J=1,6 IF(LRPY(J,I).EQ.0) GOTO 499 WRITE(IOP,) LRPY(J,I) 499 CONTINUE GOTO 2 C*************************************************************** C**************************************************************** 999 CONTINUE C CLOSE THE DANCE FILE CALL CLOSE (IOD,5HDANC1,3HSRC,IEV) 88 CALL WAITFR(IEV) IF (IEV) 89,88,89 89 WRITE (IOT,) IEV STOP END [\]. CHOR3@SRC C MAINLINE CHOR2 C------------------------------------------------------------------- C CHOR2 (ANIMATION PHASE) OF CHOREO INTERACTIVE DANCE FACILITY C AUTHOR: GLEN MCDOUGALL C C CALLS RDCON, BOOKKEEPS START & INCR ANGS FOR MODS, CALLS MOVINC C---------------------------------------------------------------------- INTEGER FRMTIM,FTIM,FDUR1,FTIMN,FDURN INTEGER NFRMS(15) REAL LRPY,FANG(3,15) C COMMON/LRPYC/LRPY(6,15),LFRM COMMON/FANGC/FANG,FRMTIM,NFRMS COMMON/IOLU/ IOT,IOP,IOD COMMON/EYCEP/EYE(3),CEN(3),UP(3) COMMON/LINKIT/ ISTRT,LINKS(6,15) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX C****************************************************************** C TERMINAL & PRINTER LUN'S IOT=4 IOP=6 IOD=17 C SET UP VIEWING PARAMETERS C "ENTER VIEW DESIRED -FRONT,TOP,SIDE" XMIN=-30. XMAX=30. YMIN=-30. YMAX=30. EYE(1)=0. EYE(2)=0. EYE(3)=60. CEN(1)=0. CEN(2)=0. CEN(3)=0. UP(1)=0. UP(2)=10. UP(3)=0. CALL ROTER CALL CLEAR(.TRUE.) C***************************************************************** DIST=60. ISTRT=1 NEW=0 C READ IN MOD & LINK INFO CALL NORMAL(DIST,NEW) C*********** CALL INPUTS LFRM=1 CALL MOVINC(DIST,NEW) C INIT LOCAL ROLL, PITCH, YAW ROTATIONS FOR EACH MODULE DO 21 M=1,15 DO 21 L=1,6 NFRMS(M)=0 21 LRPY(L,M)=0. C INIT FINAL ANGLE ARRAY DO 20 M=1,15 DO 20 L=1,3 20 FANG(L,M)=LRPY(L,M) C C READ IN TEMPO (IN BEATS/MIN) AND INIT VARS WRITE(IOT,19) 19 FORMAT(' ENTER TEMPO') READ(IOT,)TMPO FPBT=1440./TMPO C INIT PARAMETERS JUMP=0 FRMTIM=0 LFRM=0 C C OPEN THE DANCE FILE FOR FUTURE READS CALL SEEK(IOD,5HDANC1,3HSRC,IEV) 22 CALL WAITFR(IEV) IF (IEV) 999,22,23 23 CONTINUE WRITE (IOT,) IEV,FPBT C*************************************************************************** C**************************************************************** C READ & CONVERT DANCE FILE SYMBOLS INTO MOD ANGLES C STORE FINAL ANGLES IN FANG AND SET NFRMS(M) 2 CONTINUE C CALL RDCON (FPBT) C END OF DANCE ? IF (FRMTIM.LT.0) GOTO 999 C CALC INCR ANGLES FOR NEW MOVEMENTS DO 15 MOD=1,15 FDUR1=NFRMS(MOD) IF (FDUR1.EQ.0) GOTO 15 LRPY(4,MOD)=(FANG(1,MOD)-LRPY(1,MOD))/FDUR1 LRPY(5,MOD)=(FANG(2,MOD)-LRPY(2,MOD))/FDUR1 LRPY(6,MOD)=(FANG(3,MOD)-LRPY(3,MOD))/FDUR1 15 CONTINUE C***************************************************************** WRITE(IOP,)FRMTIM,LFRM,FDUR1 DO 398 I=1,15 IF (NFRMS(I).EQ.0) GOTO 398 WRITE (IOP,) NFRMS(I) 398 CONTINUE DO 399 I=1,15 DO 399 J=1,6 IF (LRPY(J,I).EQ.0) GOTO 399 WRITE (IOP,) LRPY(J,I) 399 CONTINUE C***************************************************************** C DISPLAY CHARLIE FOR LFRM FRAMES C USING LRPY ANGLES AND NFRMS C CALL MOVINC(DIST,NEW) C UPDATE FRMTIM ("ABSOLUTE CLOCK") FRMTIM=FRMTIM+LFRM C****************************************************************** C UPDATE START ANGLES AND # OF REMAINING FRAMES DO 11 M=1,15 C IF NO RECENT MOD MOVMNT -IGNORE IF (NFRMS(M).EQ.0) GOTO 11 C UPDATE START ANGS LRPY(1,M)=FANG(1,M) LRPY(2,M)=FANG(2,M) LRPY(3,M)=FANG(3,M) C UPDATE # REMAINING FRMS NFRMS(M)=NFRMS(M)-LFRM C IF MOD MOVMNT ENDS ZERO INCR ANGS FOR MOD IF (NFRMS(M).NE.0) GOTO 11 LRPY(4,M)=0. LRPY(5,M)=0. LRPY(6,M)=0. 11 CONTINUE C*************************************************************** DO 498 I=1,15 IF (NFRMS(I) .EQ.0) GOTO 498 WRITE (IOP,) NFRMS(I) 498 CONTINUE DO 499 I=1,15 DO 499 J=1,6 IF(LRPY(J,I).EQ.0) GOTO 499 WRITE(IOP,) LRPY(J,I) 499 CONTINUE GOTO 2 C*************************************************************** C**************************************************************** 999 CONTINUE C CLOSE THE DANCE FILE CALL CLOSE (IOD,5HDANC1,3HSRC,IEV) 88 CALL WAITFR(IEV) IF (IEV) 89,88,89 89 WRITE (IOT,) IEV STOP END [\]. CHRMN@SRC 1 1 13 -0.5 -1.0 1.5 2.5 0.0 2.0 2.5 0.0 2.0 2.5 1.5 2.5 2.5 1.5 2.5 2.5 1.5 -2.5 2.5 1.5 -2.5 2.5 0.0 -2.0 2.5 0.0 -2.0 -0.5 -1.0 -1.5 -0.5 -1.0 -1.5 -1.5 1.5 -2.0 -1.5 1.5 -2.0 -0.5 2.3 -1.8 -0.5 2.3 -1.8 -0.5 2.3 1.8 -0.5 2.3 1.8 -1.5 1.5 2.0 -1.5 1.5 2.0 -0.5 -1.0 1.5 -0.5 -1.0 1.5 -0.5 -1.0 -1.5 2.5 1.5 -2.5 -0.5 2.3 -1.8 -0.5 2.3 1.8 2.5 1.5 2.5 2 14 35 0.5 1.0 2.0 0.0 5.0 2.5 0.0 5.0 2.5 2.0 8.0 1.5 2.0 8.0 1.5 2.0 8.0 -1.5 2.0 8.0 -1.5 0.0 5.0 -2.5 0.0 5.0 -2.5 0.5 1.0 -2.0 0.5 1.0 -2.0 2.5 4.5 -0.5 2.5 4.5 -0.5 2.5 4.5 0.5 2.5 4.5 0.5 0.5 1.0 2.0 0.5 1.0 2.0 -0.5 1.0 1.0 -0.5 1.0 1.0 -1.5 6.0 2.5 -1.5 6.0 2.5 0.5 9.0 2.0 0.5 9.0 2.0 0.5 9.0 -2.0 0.5 9.0 -2.0 -1.5 6.0 -2.5 -1.5 6.0 -2.5 -0.5 1.0 -1.0 -0.5 1.0 -1.0 0.5 1.0 -2.0 -0.5 1.0 1.0 -0.5 1.0 -1.0 0.0 5.0 2.5 -1.5 6.0 2.5 0.0 5.0 -2.5 -1.5 6.0 -2.5 0.5 9.0 2.0 2.0 8.0 1.5 2.0 8.0 1.5 2.5 4.5 0.5 2.5 4.5 -0.5 2.0 8.0 -1.5 2.0 8.0 -1.5 0.5 9.0 -2.0 3 36 36 0.0 0.0 0.0 0.0 -6.4 0.0 4 37 37 0.0 0.0 0.0 0.0 -6.0 0.0 5 38 42 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 -0.0 0.0 -1.8 -0.8 0.0 -1.8 -0.3 0.0 -2.5 1.0 0.0 -2.5 -0.2 0.0 -2.5 -0.2 0.0 -1.2 -0.2 6 42 42 0.0 0.0 0.0 0.0 -6.4 0.0 7 43 43 0.0 0.0 0.0 0.0 -6.0 0.0 8 44 48 0.0 -2.5 0.2 0.0 -1.2 0.2 0.0 0.0 0.0 0.0 -2.5 -1.0 0.0 0.0 0.0 0.0 -1.8 0.8 0.0 -1.8 0.8 0.0 -1.8 0.3 0.0 -2.5 -1.0 0.0 -2.5 0.2 9 49 59 -0.9 0.5 1.5 -0.3 3.0 1.5 -0.3 3.0 1.5 -0.3 3.0 -1.5 -0.3 3.0 -1.5 -0.9 0.5 -1.5 -0.9 0.5 -1.5 2.6 -1.4 -0.5 2.6 -1.4 -0.5 2.4 2.4 -1.3 2.4 2.4 -1.3 2.4 2.4 1.3 2.4 2.4 1.3 2.6 -1.4 0.5 2.6 -1.4 0.5 -0.9 0.5 1.5 2.6 -1.4 0.5 2.6 -1.4 -0.5 -0.3 3.0 1.5 2.4 2.4 1.3 -0.3 3.0 -1.5 2.4 2.4 -1.3 10 60 60 0.0 0.0 0.0 0.0 -8.0 0.0 11 61 61 0.0 0.0 0.0 0.0 -7.0 0.0 12 62 67 0.0 0.0 0.0 -0.5 -1.5 1.5 -0.5 -1.5 1.5 -0.5 -1.5 -0.5 -0.5 -1.5 -0.5 0.0 0.0 0.0 0.0 0.0 0.0 3.0 -1.5 0.0 3.0 -1.5 0.0 -0.5 -1.5 1.5 -0.5 -1.5 -0.5 3.0 -1.5 0.0 13 68 68 0.0 0.0 0.0 0.0 -8.0 0.0 14 69 69 0.0 0.0 0.0 0.0 -7.0 0.0 15 70 75 0.0 0.0 0.0 -0.5 -1.5 0.5 -0.5 -1.5 0.5 -0.5 -1.5 -1.5 -0.5 -1.5 -1.5 0.0 0.0 0.0 0.0 0.0 0.0 3.0 -1.5 0.0 3.0 -1.5 0.0 -0.5 -1.5 -1.5 -0.5 -1.5 0.5 3.0 -1.5 0.0 0 1 0 2 10 13 0 0 0.0 0.0 0.0 2 1 3 6 9 0 0 0.0 2.9 0.0 3 2 4 0 0 0 0 1.4 9.0 3.4 4 3 5 0 0 0 0 0.0 -6.5 0.0 5 4 0 0 0 0 0 0.0 -6.0 0.0 6 2 7 0 0 0 0 1.4 9.0 -3.4 7 6 8 0 0 0 0 0.0 -6.5 0.0 8 7 0 0 0 0 0 0.0 -6.5 0.0 9 2 0 0 0 0 0 0.0 12.0 0.0 10 1 11 0 0 0 0 0.0 0.0 2.5 11 10 12 0 0 0 0 0 0.0 -8.0 0.0 12 11 0 0 0 0 0 0.0 -7.0 0.0 13 1 14 0 0 0 0 0.0 0.0 -2.5 14 13 15 0 0 0 0 0.0 -8.0 0.0 15 14 0 0 0 0 0 0.0 -7.0 0.0 0 0 0 0 0 0 0 [\]. CLOSE@CTE CALL COLM STOP END [\]. COLM@@LST 0001 SUBROUTINE COLM 0002 C** SUBROUTINE TO DISPLAY COLUMNS 0003 REAL COL(4,29),INC 0004 INTEGER MODE,BEGIN,END,IVECT(500),FIRST 0005 INTEGER LAST,INT,ISPACE,FCN,TAG 0006 COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX 0007 COMMON/FRAME/ XA,XB,YA,YB 0008 COMMON/VECT/ IVECT,FIRST,LAST,TAG,MODE,BEGIN,END 0009 C** COLUMN LINE DEFINITIONS 0010 COL(1,1)=2.8 0011 COL(2,1)=2 0012 COL(3,1)=19.3 0013 COL(4,1)=2 0014 C** 0015 DO 10 I=2,13 0016 COL(1,I)=2.8+1.5*(I-2) 0017 COL(2,I)=2 0018 COL(3,I)=2.8+1.5*(I-2) 0019 COL(4,I)=18 0020 10 CONTINUE 0021 C** 0022 DO 20 I=14,29 0023 INC=0 0024 IF ((I.EQ.17).OR.(I.EQ.21).OR.(I.EQ.25).OR.(I.EQ.29)) INC=.1 0025 COL(1,I)=10.2-INC 0026 COL(2,I)=2+(I-13) 0027 COL(3,I)=10.4+INC 0028 COL(4,I)=2+(I-13) 0029 20 CONTINUE 0030 CALL VECTOR(1,COL,1,29,IVECT,1,LAST,4,1,.FALSE.) 0031 CALL DSPLAY (3,99,IERR) 0032 CALL DSPLAY (6,99,IERR,IVECT,1,LAST) 0033 RETURN 0034 END [\]. COLM@@SRC SUBROUTINE COLM C** SUBROUTINE TO DISPLAY COLUMNS REAL ARR(4,32),INC C REAL XMIN,XMAX,YMIN,YMAX C REAL XA,XB,YA,YB C INTEGER FIRST,LAST,TAG,MODE,BEGIN,END,IVECT(400) INTEGER INT,ISPACE,FCN C COMMON/VECT/ FIRST,LAST,TAG,MODE,BEGIN,END,IVECT COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX COMMON/FRAME/ XA,XB,YA,YB C C** COLUMN LINE DEFINITIONS IOT=4 ARR(1,1)=2.8 ARR(2,1)=2 ARR(3,1)=19.3 ARR(4,1)=2 C** DO 10 I=2,13 ARR(1,I)=2.8+1.5*(I-2) ARR(2,I)=2 ARR(3,I)=2.8+1.5*(I-2) ARR(4,I)=18 10 CONTINUE C** DO 20 I=14,29 INC=0 IF ((I.EQ.17).OR.(I.EQ.21).OR.(I.EQ.25).OR.(I.EQ.29)) INC=.1 ARR(1,I)=10.2-INC ARR(2,I)=2+(I-13) ARR(3,I)=10.4+INC ARR(4,I)=2+(I-13) 20 CONTINUE C CALL VECTOR (1,ARR,1,29,IVECT,1,LAST,7,1,.FALSE.) CALL DSPLAY (3,51,IERR) CALL DSPLAY (6,51,IERR,IVECT,1,LAST) RETURN END [\]. CONVRTSRC SUBROUTINE RDCONV C C** SUBROUTINE TO DETERMINE ROTATIONS ABOUT C** THE COORDINATE AXES FOR EACH OF 15 MODULES C INTEGER A,B,C,D,E,F,R,S REAL AR(9) COMMON/SYMRSC/SYMRS(4,6),NM COMMON/SYMBOL/ A,B,C,D,E,F,BLEN,POS DATA AR/0.0,22.5,45.0,67.5,90.0,112.5,135.,157.5,180./ 114 CONTINUE DO 20 I=1,4 DO 20 J=1,6 20 SYMRS(I,J)=0.0 R=J=1 L=2 M=3 BETA=GAMA=EPSI=0.0 A=A+1 C=C+1 D=D+1 WRITE(4,115) 115 FORMAT (' ENTER DUMMY VALUES FOR A-F,BLEN,POS') READ(4,120) A,B,C,D,E,F,BLEN,POS 120 FORMAT(6I2,2F8.2) IF(A.EQ.99) GO TO 210 C C** DETERMINE BODY PART C GO TO (1,2,3,4,5,6,7,8,9,10,11,12),A 1 CONTINUE 6 CONTINUE 7 GO TO 210 C C** DETERMINE HAND ROTATIONS C 2 SYMRS(J,1)=8 11 IF(A.EQ.11) SYMRS(J,1)=5 GO TO (41,42,43,43,45,45,47,47,47,47,92,92),C 41 GO TO 210 42 GO TO 990 43 EPSI=AR(5) GAMA=(2*(C/4)-1)*AR(D+D/3) GO TO 990 45 EPSI=AR(9) GAMA=(2*(C/6)-1)*AR(D+D/3) GO TO 990 47 IF(C.EQ.8.OR.C.EQ.9) R=-1.0 EPSI=R*AR(7) GAMA=(2*(C/8)-1)*AR(D+D/3) GO TO 990 GO TO 990 C C** HEAD ROTATIONS C 12 SYMRS(J,1)= 9 61 GO TO (62,62,64,64,65,65,67,67,67,67,72,72),C 62 GO TO 980 64 EPSI=(2*(C/4)-1)*AR(2*D-1) GO TO 980 65 IF(C.LT.9.AND.C.NE.6) R=-1.0 GAMA=R*AR(2*D-1) GO TO 980 67 IF(C.EQ.8.OR.C.EQ.9) S=-1.0 BETA=S*AR(3) GO TO 65 72 BETA=(E-1)*AR(3) IF(C.EQ.12) BETA= -1.*BETA GO TO 980 C C** CHEST AND TORSO ROTATIONS C 3 SYMRS(J,1)= 1 10 IF(A.EQ.10) SYMRS(J,1)= 2 GO TO 61 C C** ARM ROTATIONS C 4 SYMRS(J,1)= 6 9 IF(A.EQ.9) SYMRS(J,1)= 3 IF(A.EQ.4) GO TO 940 C C** RIGHT ARM ROTATIONS C 960 GO TO (81,82,83,83,85,86,85,85,85,85,92,92),C 81 GO TO 950 C 82 IF(A.EQ.9.OR.A.EQ.4) GAMA=(2*(D/4)-1)*AR(5) IF(D.EQ.3) GAMA1=AR(9) IF(A.EQ.5.OR.A.EQ.8) GAMA=(D-3)*AR(5) GO TO 955 83 EPSI=AR(2*D-1) 831 BETA=(1-2*(C/4))*AR(5) GAMA=(D-3)*AR(3) GO TO 950 85 GAMA=(D-3)*AR(3) EPSI=(1-C/8)*AR(5) IF(C.EQ.7) BETA=AR(3) IF(C.EQ.8) BETA=-AR(3) IF(C.EQ.9) BETA=AR(7) IF(C.EQ.10) BETA=-AR(7) GO TO 950 86 GAMA=(1-2*(D/4))*AR(7+2*(D/3)) EPSI=(1-C/8)*AR(5) GO TO 950 92 EPSI=(E-1)*AR(3) IF(A.EQ.2) EPSI=-1.0*EPSI GO TO 950 C C** LEFT ARM ROTATIONS C 940 GO TO (101,102,103,103,85,86,85,85,86,86,111,112),C 101 GO TO 950 102 GO TO 82 103 EPSI=-AR(2*D-1) GO TO 831 111 CONTINUE 112 GO TO 92 C C** LEG ROTATIONS C 5 SYMRS(J,1)=13 GO TO 940 8 SYMRS(J,1)=10 GO TO 960 C C** FLEXION OF ARMS AND LEGS C 950 GAMA1=AR(1+F+F/4) 955 IF(A.EQ.8.OR.A.EQ.5) GAMA1=-1.*GAMA1 C C** ASSIGN INFORMATION TO RODAK FILE C IF(A.EQ.4) SYMRS(L,1)= 7 IF(A.EQ.5) SYMRS(L,1)= 14 IF(A.EQ.8) SYMRS(L,1)= 11 IF(A.EQ.9) SYMRS(L,1)= 4 SYMRS(L,6)= GAMA1 GO TO 990 980 IF(A.NE.3) GO TO 990 SYMRS(L,6)=SYMRS(M,6)=-GAMA SYMRS(L,1)=10 SYMRS(M,1)=13 990 IF(A.EQ.2) EPSI= -1.0*EPSI SYMRS(J,2)=SYMRS(L,2)=SYMRS(M,2)=BLEN SYMRS(J,3)=SYMRS(L,3)=SYMRS(M,3)=POS SYMRS(J,4)= EPSI SYMRS(J,5)= BETA SYMRS(J,6)= GAMA WRITE(4,) (SYMRS(J,I),I=1,6) IF(SYMRS(L,1).NE.0.0) WRITE(4,) (SYMRS(L,I),I=1,6) IF(SYMRS(M,1).NE.0.0) WRITE(4,) (SYMRS(M,I),I=1,6) GO TO 114 210 RETURN END [\]. COPEE@JOB $JOB 20(010) COPEE JOB SAVAGE $UIC $PUP T 17 _ 19 TESTD SRC $END $JOB FLUSH $END [\]. COPY@@JOB $JOB 20(003) COPY JOB $UIC $PUP T 6 _ 17 TESTD SRC $END $JOB FLUSH $END [\]. CTEST@JOB $JOB 21 T=5 UFD=RK1 $MSG CTEST -CTEST TKB STEP $DEL CTEST TSK $DEL CTEST IMG $TKB SZ,UL:F4LIB} CTEST} 350} TDV.GR} CTEST} } $CON CTEST} $END [\]. CTEST@SRC C CTEST *TEST TO GET BLOODY GRAPHICS WORKING!!!!! REAL ARR(4,4),INC C INTEGER FIRST,LAST,TAG,MODE,BEGIN,END,IVECT(125) INTEGER INT,ISPACE,FCN C COMMON/VECT/ FIRST,LAST,TAG,MODE,BEGIN,END,IVECT COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX C XMIN=0. XMAX=20. YMIN=0. YMAX=20. IOP=6 IOT=4 FIRST=1 TAG=1 MODE=1 BEGIN=1 END=2 C CALL CLEAR(.TRUE.) C** COLUMN LINE DEFINITIONS ARR(1,1)=2.8 ARR(2,1)=2 ARR(3,1)=19.3 ARR(4,1)=2 ARR(1,2)=2.8 ARR(2,2)=4 ARR(3,2)=19.3 ARR(4,2)=4 C** C*********** CCALL DSPLAY(7,IGET,IERR) CWRITE(IOP,) IGET,IERR CALL VECTOR (MODE,ARR,BEGIN,END,IVECT,FIRST,LAST,6,0,-1) WRITE(IOP,) LAST,IERR,ARR,IVECT(1),IVECT(2),IVECT(3) WRITE(IOP,) IVECT(4),IVECT(5),IVECT(6),IVECT(7),IVECT(8) WRITE(IOP,) IVECT(9),IVECT(10),IVECT(11),IVECT(12),IVECT(13) MODE=3 C CCALL DSPLAY (MODE,TAG,IERR) CWRITE(IOT,) IERR CMODE=6 CCALL DSPLAY (MODE,TAG,IERR,IVECT,FIRST,LAST) WRITE (IOT,10) 10 FORMAT (' ENTER : FIRST,LAST') READ (IOT,) FIRST,LAST CALL DRAW (IVECT,FIRST,LAST) PAUSE 1 WRITE(IOT,) IERR C RETURN STOP END [\]. DANC1@SRC 999 1 0 0 0 0 0.000 0.000 [\]. DANC2@SRC 2 0 3 1 0 0 1.000 0.000 2 0 3 2 0 0 1.000 1.000 2 0 3 3 0 0 1.000 2.000 2 0 5 1 0 0 1.000 3.000 2 0 5 2 0 0 1.000 4.000 2 0 5 3 0 0 1.000 5.000 2 0 7 1 0 0 1.000 6.000 2 0 7 2 0 0 1.000 7.000 2 0 7 3 0 0 1.000 8.000 2 0 9 1 0 0 1.000 9.000 2 0 9 2 0 0 1.000 10.000 2 0 9 3 0 0 1.000 11.000 2 0 11 1 0 0 1.000 12.000 2 0 11 2 0 0 1.000 13.000 2 0 11 3 0 0 1.000 14.000 2 0 11 2 0 0 1.000 15.000 998 0 0 0 0 0 0.000 0.000 999 0 0 0 0 0 0.000 0.000 [\]. DANC3@SRC 998 1 4 0 0 0 0.000 0.000 2 0 3 1 0 0 1.000 0.000 2 0 3 2 0 0 1.000 1.000 2 0 3 3 0 0 1.000 2.000 2 0 5 3 0 0 1.000 3.000 998 2 4 0 0 0 0.000 0.000 2 0 5 1 0 0 1.000 4.000 2 0 5 2 0 0 1.250 5.000 2 0 7 2 0 0 1.000 6.250 2 0 7 1 0 0 1.000 7.250 998 3 1 0 0 0 0.000 0.000 2 0 7 3 0 0 1.000 8.250 999 4 9 0 0 0 0.000 0.000 [\]. DANC4@SRC 998 1 4 0 0 0 0.000 0.000 2 0 3 1 0 0 1.000 0.000 2 0 3 2 0 0 1.000 1.000 999 4 9 0 0 0 0.000 0.000 [\]. DANC5@SRC 998 4 22 0 0 0 0.000 0.000 2 0 4 2 0 0 0.500 00.000 4 0 0 0 0 0 1.000 00.000 5 0 1 2 0 0 1.000 00.000 6 0 1 2 0 0 1.000 00.000 7 0 0 0 0 0 3.000 00.000 9 0 5 2 0 0 0.500 00.000 2 0 3 1 0 0 0.500 00.500 9 0 2 1 0 0 0.500 00.500 2 0 4 2 0 0 1.000 1.000 4 0 0 0 0 0 1.000 1.000 5 0 0 2 0 0 2.000 1.000 6 0 1 2 0 0 2.000 1.000 9 0 5 2 0 0 1.000 1.000 2 0 2 2 0 0 1.000 2.000 4 0 2 3 0 0 0.500 2.000 9 0 3 2 0 0 1.000 2.000 4 0 3 2 0 0 0.500 2.500 2 0 1 3 0 0 1.000 3.000 5 0 1 2 0 0 1.000 3.000 7 0 3 3 0 0 0.500 3.000 9 0 1 3 0 0 1.000 3.000 7 0 2 2 0 0 0.500 3.500 999 5 37 0 0 0 0.000 0.000 [\]. DANC6@SRC 998 1 2 0 0 0 0.000 0.000 2 0 2 3 2 6 1.000 0.000 4 0 4 2 0 0 1.000 0.000 999 2 2 0 0 0 0.000 0.000 998 1 4 0 0 0 0.000 0.000 2 0 4 2 0 0 1.000 0.000 2 0 9 2 0 0 1.000 1.000 2 0 3 2 0 0 1.000 2.000 2 0 11 2 0 0 1.000 3.000 998 2 4 0 0 0 0.000 0.000 2 0 7 2 0 0 1.000 4.000 2 0 10 2 0 0 1.000 5.000 2 0 2 2 0 0 1.000 6.000 2 0 8 2 0 0 1.000 7.000 998 3 1 0 0 0 0.000 0.000 2 0 4 2 0 0 1.000 8.000 2 0 4 2 0 0 1.000 9.000 999 4 9 0 0 0 0.000 0.000 [\]. DATA@@SRC 350. 900. 550. 575. 200. 500. 230. 275. 250. 175. 700. 900. 260. 575. 250. 500. 410. 275. 250. 175. 350. 900. 800. 575. 500. 425. 120. 275. 250. 175. 575. 175. [\]. DIRECTJOB $JOB 20(010) DIRECT JOB /MCDOUGALL $UIC $PUP L 16 _ 15 $JOB FLUSH $END [\]. DRAWITSRC SUBROUTINE DRAWIT(DIST,NEW,MODULE,IFUNC) C DRAWS CHARLIE IN 2D USING 3D INFO INTEGER NEW,MODULE,IFUNC REAL DIST COMMON/PAINT/I2STRT,I2END,PICT(4,100) COMMON/POINTS/LNS(2,15),PTS(6,100) COMMON/BULK/I3STRT,I3END,OBJ(6,100) COMMON/OIL/IVECT(400) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX MODL=MODULE 2 I2STRT=LNS(1,MODL) I2END=LNS(2,MODL) I3STRT=I2STRT I3END=I2END CALL MAPPER(DIST) CALL VECTOR(1,PICT,I2STRT,I2END,IVECT,1,LAST,6,0,-1) CALL DSPLAY(3,MODL,IER) CALL DSPLAY(IFUNC,MODL,IER,IVECT,1,LAST) CALL NEXT(MODL,MODULE) IF (MODULE.NE.MODL) GOTO 2 RETURN END [\]. EDITD@SRC SUBROUTINE EDITD C****** EDITS DANCE FILES FOR SYM ADDS,DELS,CHANGES C****** NOT CODED YET RETURN END [\]. ERASE@SRC C****** SUBROUTINE TO ERASE SYMBOLS FROM SCREEN SUBROUTINE ERASE CALL DSPLAY (8,IGET,IERR) RETURN END [\]. FILMODSRC C SUBROUTINE TO FILL OBJ C SUBROUTINE FILMOD(INMOD) COMMON/PROD/PAC(3,3,15) COMMON/SUMIT/PSUM(3,16,5) COMMON/POINTS/LNS(2,15),PTS(6,100) COMMON/BULK/I3STRT,I3END,OBJ(6,100) COMMON/LINKIT/ISTRT,LINKS(6,15) MODULE=INMOD INDEX=2 2 IMOD=LINKS(1,MODULE) CALL PRTPRD(IMOD,MODULE) CALL PRTSUM(IMOD,MODULE) IF(IMOD.EQ.0)IMOD=16 I3STRT=LNS(1,MODULE) I3END=LNS(2,MODULE) DO 69 K=I3STRT,I3END DO 69 I=1,3 SUM=0. DO 68 L=1,3 68 SUM=PAC(I,L,MODULE)*PTS(L,K)+SUM 69 OBJ(I,K)=SUM DO 79 K=I3STRT,I3END DO 79 I=1,3 SUM=0. II=I+3 DO 78 L=1,3 78 SUM=PAC(I,L,MODULE)*PTS(L+3,K)+SUM 79 OBJ(II,K)=SUM IF(IMOD.EQ.16)GO TO 12 I=1 10 I=I+1 INSON=LINKS(I,IMOD) IF(INSON.NE.MODULE)GO TO 10 INSON=I-1 GO TO 13 12 INSON=1 13 DO 96 K=I3STRT,I3END DO 96 I=1,6 II=I IF(I.GT.3)II=I-3 96 OBJ(I,K)=OBJ(I,K)+PSUM(II,IMOD,INSON) CALL NEXT(MODULE,INMOD) IF(MODULE.EQ.INMOD)GO TO 99 GO TO 2 C WRITE (6,) RAC,PAC,PSUM 99 RETURN END [\]. FLUSH1JOB $JOB 20(050) FLUSH1 JOB / MCDOUGALL $UIC $END $JOB FLUSH $END [\]. FLXDANSRC 2 0 1 0 0 0 0.000 0.000 2 0 1 1 0 1 1.000 1.000 2 0 1 0 0 0 1.000 2.000 2 0 1 0 0 3 1.000 3.000 2 0 1 0 0 0 1.000 4.000 2 0 1 0 0 5 1.000 5.000 2 0 1 0 0 0 1.000 6.000 2 0 1 0 0 3 1.000 7.000 2 0 1 0 0 0 1.000 8.000 2 0 1 0 0 6 1.000 9.000 2 0 1 0 0 6 1.000 10.000 999 0 0 0 0 0 0.000 0.000 [\]. INCREMSRC C SUBROUTINE INCREM REAL AX,AY,AZ,FRTIM,ROT(15,3),GUANO(15,10),LEN REAL POS,THY,THX,THZ,FPBT,TMPO INTEGER FL,OUTLU DATA FRTIM,II/0.0,1/ DATA GUANO,ROT/150*0.0,45*0.0/ OUTLU=4 WRITE(OUTLU,19) 19 FORMAT(' ENTER TEMPO') READ(OUTLU,)TMPO FPBT=1440/TMPO MINDUR=0 WRITE(OUTLU,3133) 3133 FORMAT(' FILE LENGTH') READ(OUTLU,)FL 1 WRITE(OUTLU,13) 13 FORMAT(' ENTER M POS LEN X Y Z') IF(II.GT.FL)GO TO 8 MINDUR=4 READ(OUTLU,)M,POS,LEN,THX,THY,THZ II=II+1 FRML=LEN*FPBT FRMP=POS*FPBT WRITE(OUTLU,)M,POS,LEN,THX,THY,THZ,FRML,FRMP,FRTIM WRITE(OUTLU,)MINDUR 101 FORMAT(10F6.2) C C UPDATE LINES IN GUANO WHERE SYMBOLS START C 2 IF(FRTIM.LT.FRMP) GO TO 3 C GUANO(M,5)=GUANO(M,2) GUANO(M,6)=GUANO(M,3) GUANO(M,7)=GUANO(M,4) GO TO 44 IF(THY.EQ.0.0)GO TO 11 IF(THY.EQ.90.0)GO TO 22 GO TO 44 11 IF(THZ.EQ.90.0)GUANO(M,9)=0.0 GO TO 33 22 IF(THZ.NE.0.0)GO TO 44 GUANO(M,9)=0.0 GO TO 33 44 GUANO(M,2)=THX GUANO(M,3)=THY GUANO(M,4)=THZ GUANO(M,9)=(GUANO(M,3)-GUANO(M,6))/FRML 33 GUANO(M,8)=(GUANO(M,2)-GUANO(M,5))/FRML GUANO(M,10)=(GUANO(M,4)-GUANO(M,7))/FRML GUANO(M,1)=GUANO(M,1)+FRML MINDUR=MIN0(MINDUR,INT(GUANO(M,1))) GO TO 1 3 WRITE(OUTLU,69)((GUANO(LL,KK),KK=1,10),LL=1,15) 69 FORMAT(10F6.2) C C UPDATE LINES IN GUANO WHERE SYMBOLS CONTINUE C DO 5 MD=1,15 IF(FRTIM.LT.GUANO(MD,1))GO TO 4 C C UPDATE LINES IN GUANO WHERE RESTS START C GUANO(MD,5)=GUANO(MD,2) GUANO(MD,6)=GUANO(MD,3) GUANO(MD,7)=GUANO(MD,4) GUANO(MD,8)=0. GUANO(MD,9)=0. GUANO(MD,10)=0. GUANO(MD,1)=GUANO(MD,1)+MINDUR GO TO 5 C RESET STARTING TIMES 4 GUANO(MD,5)=GUANO(MD,5)+GUANO(MD,8)*MINDUR GUANO(MD,6)=GUANO(MD,6)+GUANO(MD,9)*MINDUR GUANO(MD,7)=GUANO(MD,7)+GUANO(MD,10)*MINDUR 5 CONTINUE WRITE(OUTLU,69)((GUANO(LLL,KKK),KKK=1,10),LLL=1,15) C C DO FOR MINDUR FRAMES C DO 7 L=1,MINDUR C C FOR EACH FRAME INCREMENT THE 15 MODULES C DO 6 MOD=1,15 AX=GUANO(MOD,5)+GUANO(MOD,8)*L AY=GUANO(MOD,6)+GUANO(MOD,9)*L AZ=GUANO(MOD,7)+GUANO(MOD,10)*L CALL ROTATE(AX,0.,0.,MOD) CALL ROTATE(0.,AY,0.,MOD) CALL ROTATE(0.,0.,AZ,MOD) C C FILL UP ROT WITH ABSOLUTE MODULE ORIENTATIONS C GO TO(10,20,30,40,50,30,60,70,30,20,80, @90,20,100,110),MOD C C HIPS (1) C 10 ROT(1,1)=AX ROT(1,2)=AY ROT(1,3)=AZ GO TO 6 C C TORSO,UPPER RIGHT LEG,UPPER LEFT LEG C ( 2 10 13 ) C 20 ROT(MOD,1)=ROT(1,1)+AX ROT(MOD,2)=ROT(1,2)+AY ROT(MOD,3)=ROT(1,3)+AZ GO TO 6 C C UPPER RIGHT ARMD,UPPER LEFT ARMD,HEAD C ( 3 6 9 ) C 30 ROT(MOD,1)=ROT(2,1)+AX ROT(MOD,2)=ROT(2,2)+AY ROT(MOD,3)=ROT(2,3)+AZ GO TO 6 C C LOWER ARM (4) C 40 ROT(MOD,1)=ROT(3,1)+AX ROT(MOD,2)=ROT(3,2)+AY ROT(MOD,3)=ROT(3,3)+AZ GO TO 6 C C LEFT HAND (5) C 50 ROT(MOD,1)=ROT(4,1)+AX ROT(MOD,2)=ROT(4,2)+AY ROT(MOD,3)=ROT(4,3)+AZ GO TO 6 C C LOWER LEFT ARM (7) C 60 ROT(MOD,1)=ROT(6,1)+AX ROT(MOD,2)=ROT(6,2)+AY ROT(MOD,3)=ROT(6,3)+AZ GO TO 6 C C RIGHT HAND (8) C 70 ROT(MOD,1)=ROT(7,1)+AX ROT(MOD,2)=ROT(7,2)+AY ROT(MOD,3)=ROT(7,3)+AZ GO TO 6 C C LOWER RIGHT LEG (10) C 80 ROT(MOD,1)=ROT(10,1)+AX ROT(MOD,2)=ROT(10,2)+AY ROT(MOD,3)=ROT(10,3)+AZ GO TO 6 C C RIGHT FOOT (12) C 90 ROT(MOD,1)=ROT(11,1)+AX ROT(MOD,2)=ROT(11,2)+AY ROT(MOD,3)=ROT(11,3)+AZ GO TO 6 C C LOWER LEFT LEG (14) C 100 ROT(MOD,1)=ROT(13,1)+AX ROT(MOD,2)=ROT(13,2)+AY ROT(MOD,3)=ROT(13,3)+AZ GO TO 6 C C LEFT FOOT (15) C 110 ROT(MOD,1)=ROT(14,1)+AX ROT(MOD,2)=ROT(14,2)+AY ROT(MOD,3)=ROT(14,3)+AZ 6 CONTINUE 99 FORMAT(3F7.3) C C BUILD AND DISPLAY MODULES FOR THIS FRAME C 111 FORMAT(10F6.2) 7 CONTINUE WRITE(OUTLU,99)((ROT(NN,JJ),JJ=1,3),NN=1,15) FRTIM=FRTIM+MINDUR GO TO 2 8 CONTINUE STOP END C [\]. INITL@SRC SUBROUTINE INITL(NEW) C SUBROUTINE TO INITIALIZE LINKS AND RAC C AFTER EACH FRAME C NEW = 1 ZERO LINKS AND RAC; NEW = 0 ZERO RAC ONLY. COMMON/LINKIT/ISTRT,LINKS(6,15) COMMON/ACCUM/RAC(3,3,15) C C CHANGE LINK INFO IF SUPPORT CHANGES? IF(NEW.NE.1)GO TO 50 DO 96 I=1,15 DO 96 J=1,6 96 LINKS(J,I)=0 C C INIT RAC (LOCAL FRAME ROTATIONS) 50 CONTINUE DO 69 I=1,15 DO 69 J=1,3 DO 69 K=1,3 RAC(K,J,I)=0. IF(K.EQ.J)RAC(K,J,I)=1. 69 CONTINUE RETURN END [\]. INPUTSSRC SUBROUTINE INPUTS C READS MOD,LINK INFO FROM CHRMN SRC REAL PTS,PSUM,C INTEGER MOD,IST,IEN INTEGER PARENT,SON1,SON2,SON3,SON4,SON5 COMMON/IOLU/ IOT,IOP COMMON/POINTS/LNS(2,15),PTS(6,100) COMMON/CENTS/C(3,15) COMMON/LINKIT/ISTRT,LINKS(6,15) COMMON/SUMIT/PSUM(3,16,5) C MODULE INFO ARRAYS: C PTS- ENDPTS OF EACH LINE IN EACH MODULE C LNS- STRT & END LINES FOR EACH MODULE CALL SEEK(17,5HCHRMN,3HSRC,IEV) 4 READ(17,) MOD IF (MOD.EQ.0) GOTO 5 READ (17,) IST,IEN LNS(1,MOD)=IST LNS(2,MOD)=IEN READ(17,)((PTS(J,K),J=1,6),K=IST,IEN) GOTO 4 C LINK INFO 5 READ (17,) MOD,PARENT,SON1,SON2,SON3,SON4,SON5 IF (MOD.EQ.0) GOTO 99 LINKS(1,MOD)=PARENT LINKS(2,MOD)=SON1 LINKS(3,MOD)=SON2 LINKS(4,MOD)=SON3 LINKS(5,MOD)=SON4 LINKS(6,MOD)=SON5 READ(17,)(C(J,MOD),J=1,3) IF (PARENT.NE.0) GOTO 5 DO 11 I=1,3 11 PSUM(I,16,1)=C(I,MOD) GOTO 5 99 CALL CLOSE(17) C WRITE(IOP,) LINKS,LNS,PTS,PSUM,C RETURN END [\]. LOAD@@JOB $JOB 20(002) 'LOAD' $UIC $PUP T 15 _ 19 13MY77 BKS $END [\]. MAIN@@SRC C MAINLINE TO TEST SUBROUTINES CALL ??? STOP END [\]. MOVINCSRC SUBROUTINE MOVINC(DIST,NEW) C FOR EACH FRAME -ROTATE MODULES & DISPLAY CHARLIE C INTEGER FRMTIM,FDURN REAL LRPY C COMMON/IOLU/ IOT,IOP,IOD COMMON/EYCEP/EYE(3),CEN(3),UP(3) COMMON/LINKIT/ ISTRT,LINKS(6,15) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX COMMON/LRPYC/LRPY(6,15),LFRM C*********************************************************************** C BUILD & DISPLAY LFRM FRAMES DO 1250 IFRM=1,LFRM C FOR THIS FRAME ... CALL INITL(0) DO 1240 M=1,15 C FOR THIS MODULE ... C ROTATE MODULE M AX=LRPY(1,M)+IFRM*LRPY(4,M) AY=LRPY(2,M)+IFRM*LRPY(5,M) AZ=LRPY(3,M)+IFRM*LRPY(6,M) C C WRITE(IOT,) AZ,AY,AX CALL ROTATE(AY,AZ,AX,M) C C TRANSLATE MODULE M (JUMP) IF ((JUMP.EQ.0).AND.(M.NE.1)) GOTO 1240 DX = 1 DY = 1 DZ = 1 C CALL TRANS(DX,DY,DZ) 1240 CONTINUE C BUILD, DISPLAY & STORE FRAME CALL FILMOD(1) CALL DRAWIT(DIST,0,1,6) C CALL PULSE(ID,IF) 1250 CONTINUE C****************************************************************** RETURN END [\]. NEXT@@SRC SUBROUTINE NEXT(MOD,INMOD) C PICKS OUT NEXT MODULE TO BE PROCESSED COMMON/LINKIT/ISTRT,LINKS(6,15) C INDEX=2 100 MOD1=LINKS(INDEX,MOD) IF(MOD1.EQ.0)GO TO 102 MOD=MOD1 GO TO 2 102 IF(INDEX.GE.6)GO TO 101 INDEX=INDEX+1 GO TO 100 101 IF(MOD.EQ.INMOD)GO TO 2 IPAR=LINKS(1,MOD) INDEX=1 104 INDEX=INDEX+1 ITEST=LINKS(INDEX,IPAR) IF(ITEST.EQ.MOD)GO TO 103 GO TO 104 103 MOD=IPAR GO TO 102 2 RETURN END [\]. NORMALSRC SUBROUTINE NORMAL(DIST,NEW) C READ IN MOD, LINK INFO & NORMALIZE CHARLIE COMMON/LINKIT/ISTRT,LINKS(6,15) COMMON/BULK/I3STRT,I3END,OBJ(6,100) C ZERO OUT LINKS & RAC ARRAYS CALL INITL(NEW) C READ IN MODULE & LINK INFO FOR CHARLIE, HIPS ARE BASE MODULE CALL INPUTS ISTRT=1 IFUNC=6 C************* 10 CONTINUE WRITE(4,11) 11 FORMAT(' Y Z X M') READ(4,) Z,Y,X,M IF (Z.EQ.999.) GOTO 999 CALL ROTATE(Z,Y,X,M) GOTO 30 C NORMALIZE HANDS,FEET CALL ROTATE(90.0,0.,0.,5) CALL ROTATE(-90.0,0.,0.,8) CALL ROTATE(0.,0.,90.0,12) CALL ROTATE(0.,0.,90.0,15) C HEAD C TORSO C L ARM CALL ROTATE(0.,0.,-90.0,6) C R ARM CALL ROTATE(0.,0.,-90.0,3) C L LEG CALL ROTATE(0.,0.,-90.0,13) C R LEG CALL ROTATE(0.,0.,-90.0,10) C BODY CALL ROTATE(0.,90.0,0.,1) C CONTRUCT POSITION & RECORD 30 CONTINUE CALL FILMOD(ISTRT) CALL DRAWIT(DIST,NEW,ISTRT,IFUNC) C CALL PULSE(ID,IF) GOTO 10 C999 WRITE(6,) ((OBJ(I,J),I=1,6),J=1,80) 999 CONTINUE RETURN END [\]. OCHRMNSRC 1 1 13 -0.5 -1.0 1.5 2.5 0.0 2.0 2.5 0.0 2.0 2.5 1.5 2.5 2.5 1.5 2.5 2.5 1.5 -2.5 2.5 1.5 -2.5 2.5 0.0 -2.0 2.5 0.0 -2.0 -0.5 -1.0 -1.5 -0.5 -1.0 -1.5 -1.5 1.5 -2.0 -1.5 1.5 -2.0 -0.5 2.3 -1.8 -0.5 2.3 -1.8 -0.5 2.3 1.8 -0.5 2.3 1.8 -1.5 1.5 2.0 -1.5 1.5 2.0 -0.5 -1.0 1.5 -0.5 -1.0 1.5 -0.5 -1.0 -1.5 2.5 1.5 -2.5 -0.5 2.3 -1.8 -0.5 2.3 1.8 2.5 1.5 2.5 2 14 35 0.5 1.0 2.0 0.0 5.0 2.5 0.0 5.0 2.5 2.0 8.0 1.5 2.0 8.0 1.5 2.0 8.0 -1.5 2.0 8.0 -1.5 0.0 5.0 -2.5 0.0 5.0 -2.5 0.5 1.0 -2.0 0.5 1.0 -2.0 2.5 4.5 -0.5 2.5 4.5 -0.5 2.5 4.5 0.5 2.5 4.5 0.5 0.5 1.0 2.0 0.5 1.0 2.0 -0.5 1.0 1.0 -0.5 1.0 1.0 -1.5 6.0 2.5 -1.5 6.0 2.5 0.5 9.0 2.0 0.5 9.0 2.0 0.5 9.0 -2.0 0.5 9.0 -2.0 -1.5 6.0 -2.5 -1.5 6.0 -2.5 -0.5 1.0 -1.0 -0.5 1.0 -1.0 0.5 1.0 -2.0 -0.5 1.0 1.0 -0.5 1.0 -1.0 0.0 5.0 2.5 -1.5 6.0 2.5 0.0 5.0 -2.5 -1.5 6.0 -2.5 0.5 9.0 2.0 2.0 8.0 1.5 2.0 8.0 1.5 2.5 4.5 0.5 2.5 4.5 -0.5 2.0 8.0 -1.5 2.0 8.0 -1.5 0.5 9.0 -2.0 3 36 36 0.0 0.0 0.0 6.4 0.0 0.0 4 37 37 0.0 0.0 0.0 6.0 0.0 0.0 5 38 42 0.0 0.0 0.0 2.5 0.0 1.0 0.0 0.0 0.0 1.8 0.0 -0.8 1.8 0.0 -0.8 1.8 0.0 -0.3 2.5 0.0 1.0 2.5 0.0 -0.2 2.5 0.0 -0.2 1.2 0.0 -0.2 6 42 42 0.0 0.0 0.0 6.4 0.0 0.0 7 43 43 0.0 0.0 0.0 6.0 0.0 0.0 8 44 48 2.5 0.0 0.2 1.2 0.0 0.2 0.0 0.0 0.0 2.5 0.0 -1.0 0.0 0.0 0.0 1.8 0.0 0.8 1.8 0.0 0.8 1.8 0.0 0.3 2.5 0.0 -1.0 2.5 0.0 0.2 9 49 59 -0.9 0.5 1.5 -0.3 3.0 1.5 -0.3 3.0 1.5 -0.3 3.0 -1.5 -0.3 3.0 -1.5 -0.9 0.5 -1.5 -0.9 0.5 -1.5 2.6 -1.4 -0.5 2.6 -1.4 -0.5 2.4 2.4 -1.3 2.4 2.4 -1.3 2.4 2.4 1.3 2.4 2.4 1.3 2.6 -1.4 0.5 2.6 -1.4 0.5 -0.9 0.5 1.5 2.6 -1.4 0.5 2.6 -1.4 -0.5 -0.3 3.0 1.5 2.4 2.4 1.3 -0.3 3.0 -1.5 2.4 2.4 -1.3 10 60 60 0.0 0.0 0.0 8.0 0.0 0.0 11 61 61 0.0 0.0 0.0 7.0 0.0 0.0 12 62 67 0.0 0.0 0.0 -0.5 -1.5 1.5 -0.5 -1.5 1.5 -0.5 -1.5 -0.5 -0.5 -1.5 -0.5 0.0 0.0 0.0 0.0 0.0 0.0 3.0 -1.5 0.0 3.0 -1.5 0.0 -0.5 -1.5 1.5 -0.5 -1.5 -0.5 3.0 -1.5 0.0 13 68 68 0.0 0.0 0.0 8.0 0.0 0.0 14 69 69 0.0 0.0 0.0 7.0 0.0 0.0 15 70 75 0.0 0.0 0.0 -0.5 -1.5 0.5 -0.5 -1.5 0.5 -0.5 -1.5 -1.5 -0.5 -1.5 -1.5 0.0 0.0 0.0 0.0 0.0 0.0 3.0 -1.5 0.0 3.0 -1.5 0.0 -0.5 -1.5 -1.5 -0.5 -1.5 0.5 3.0 -1.5 0.0 0 1 0 2 10 13 0 0 0.0 0.0 0.0 2 1 3 6 9 0 0 0.0 2.9 0.0 3 2 4 0 0 0 0 1.4 9.0 3.4 4 3 5 0 0 0 0 6.5 0.0 0.0 5 4 0 0 0 0 0 6.0 0.0 0.0 6 2 7 0 0 0 0 1.4 9.0 -3.4 7 6 8 0 0 0 0 6.5 0.0 0.0 8 7 0 0 0 0 0 6.0 0.0 0.0 9 2 0 0 0 0 0 0.0 12.0 0.0 10 1 11 0 0 0 0 0.0 0.0 2.5 11 10 12 0 0 0 0 0 8.0 0.0 0.0 12 11 0 0 0 0 0 7.0 0.0 0.0 13 1 14 0 0 0 0 0.0 0.0 -2.5 14 13 15 0 0 0 0 8.0 0.0 0.0 15 14 0 0 0 0 0 7.0 0.0 0.0 0 0 0 0 0 0 0 [\]. ODRAWISRC C SUBROUTINE TO DRAW STRUCTURE SUBROUTINE DRAWIT(DIST,NEW,MODULE,IFUNC) COMMON/PAINT/I2STRT,I2END,PICT(4,100) COMMON/POINTS/LNS(2,15),PTS(6,100) COMMON/BULK/I3STRT,I3END,OBJ(6,100) COMMON/OIL/IVECT(300) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX COMMON/EYCEP/EYE(3),CEN(3),UP(3) COMMON/LINKIT/ISTRT,LINKS(6,15) MODL=MODULE IF(NEW.EQ.2)GO TO 3 IF(NEW.EQ.1)GO TO 1 3 MOD=MODULE 9 CALL DSPLAY(3,MOD,IER) CALL NEXT(MOD,MODULE) IF(MOD.EQ.MODULE)GO TO 4 GO TO 9 4 IF(NEW.NE.2)GO TO 2 1 CALL ROTER 2 I2STRT=LNS(1,MODL) I2END=LNS(2,MODL) I3STRT=I2STRT I3END=I2END CALL MAPPER(DIST) CALL VECTOR(1,PICT,I2STRT,I2END,IVECT,1,LAST,6,0,-1) CALL DSPLAY(IFUNC,MODL,IER,IVECT,1,LAST) CALL NEXT(MODL,MODULE) IF(MODL.EQ.MODULE)GO TO 5 GO TO 2 5 NEW=0 RETURN END [\]. OPEN@@COM CLOSE OPEN [\]. PHASE2SRC C SUBROUTINE PHASE2 C PHASE2 (ANIMATION PHASE) FOR CHOREO INTERACTIVE DANCE FACILITY C ** G.A. MCDOUGALL ** C READS SYMBOL FILE, GETS MODULE ANGLES, UPDATES LRPY ARRAY C INTEGER FRMTIM,FTIM,FDUR,FTIMN,FDURN INTEGER NFRMS(15) REAL LRPY C COMMON/LRPYC/LRPY(6,15),LFRM COMMON/SYMRS0/SYMRS(4,4),NM,FDUR,FTIM COMMON/SYMRS1/SYMRSN(4,4),NMN,FDURN,FTIMN COMMON/IOLU/ IOT,IOP,IOD COMMON/EYCEP/EYE(3),CEN(3),UP(3) COMMON/LINKIT/ ISTRT,LINKS(6,15) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX C****************************************************************** C TERMINAL & PRINTER LUN'S IOT=4 IOP=6 IOD=17 C SET UP VIEWING PARAMETERS C "ENTER VIEW DESIRED -FRONT,TOP,SIDE" XMIN=-30. XMAX=30. YMIN=-30. YMAX=30. EYE(1)=0. EYE(2)=0. EYE(3)=60. CEN(1)=0. CEN(2)=0. CEN(3)=0. UP(1)=0. UP(2)=10. UP(3)=0. CALL CLEAR(.TRUE.) C***************************************************************** DIST=60. NEW=1 C READ IN MOD & LINK INFO, NORMALIZE CHARLIE & DISPLAY HIM CALL NORMAL(DIST,NEW) C INIT LOCAL ROLL, PITCH, YAW ROTATIONS FOR EACH MODULE DO 21 M=1,15 DO 21 L=1,6 NFRMS(M)=0 21 LRPY(L,M)=0. C READ IN TEMPO (IN BEATS/MIN) AND INIT VARS WRITE(IOT,19) 19 FORMAT(' ENTER TEMPO') READ(IOT,)TMPO FPBT=1440./TMPO C INIT PARAMETERS JUMP=0 FRMTIM=0 LFRM=0 C WRITE (IOT,) TMPO,FPBT,FRMTIM,LFRM GOTO 12 C*************************************************************************** C FOR ALL MODULES -UPDATE START ANGS, INCREM ANGS& REMAINING FRAMES 2 CONTINUE DO 11 M=1,15 C IF NO RECENT MOD MOVMENT -DO NEXT MOD IF (NFRMS(M) .EQ. 0) GOTO 11 C UPDATE START POSITION ANGLES LRPY(1,M)=LRPY(1,M)+LFRM*LRPY(4,M) LRPY(2,M)=LRPY(2,M)+LFRM*LRPY(5,M) LRPY(3,M)=LRPY(3,M)+LFRM*LRPY(6,M) C UPDATE # OF REMAINING FRAMES NFRMS(M)=NFRMS(M)-LFRM C IF MOVEMENT HAS ENDED -SET INCR ROTS TO ZERO IF (NFRMS(M) .NE. 0) GOTO 11 LRPY(4,M)=0. LRPY(5,M)=0. LRPY(6,M)=0. 11 CONTINUE WRITE (IOP,) NFRMS WRITE (IOP,) (LRPY(I,1),I=1,6) C**************************************************************** C CONTINUE WITH LAST (OLD) SYMBOL READ IN LAST TIME C SET INCREMENTAL ANGLES FOR NEW MOVEMENT 14 CONTINUE C UPDATE SYMRS DO 60 I=1,NMN DO 60 J=1,4 60 SYMRS(I,J)=SYMRSN(I,J) FTIM=FTIMN FDUR=FDURN NM=NMN C DO 15 I=1,NM MOD=IFIX(SYMRS(I,1)) NFRMS(MOD)=FDUR C LRPY(4,MOD)=(SYMRS(I,2)-LRPY(1,MOD))/FDUR LRPY(5,MOD)=(SYMRS(I,3)-LRPY(2,MOD))/FDUR LRPY(6,MOD)=(SYMRS(I,4)-LRPY(3,MOD))/FDUR 15 CONTINUE C***************************************************************** C READ SYMBOL FILE & CONVERT TO ANGLES FOR 1-4 MODULES C PROCESS ONLY THOSE SYMBOLS WHICH START AT FRAMTIM 12 CONTINUE CALL RDCONV(FPBT) C********************** WRITE(IOP,)FRMTIM,FTIM,FDUR,NFRMS,SYMRS WRITE(IOP,) FTIMN,FDURN,NMN,SYMRSN C C END OF DANCE??? IF (FTIMN .LT.0) GOTO 999 C IF SYMBOL STARTS AFTER FRMTIM LEAVE IT FOR NEXT RETURN C & PROCESS PREVIOUS SYMBOLS IF (FTIMN .LE. FRMTIM) GOTO 14 C***************************************************************** C LFRM = #FRAMES TO BE PROCESSED IN MOVINC C = MIN (NON 0) VALU OF NFRAMES C 100 NLOW=1000 DO 101 M=1,15 LOW=NFRMS(M) IF (LOW .EQ. 0) GOTO 101 IF (NLOW .GT. LOW) NLOW=LOW 101 CONTINUE LFRM=NLOW C************************************************************ C DISPLAY CHARLIE FOR LFRM FRAMES CALL MOVINC(DIST,NEW) C UPDATE FRMTIM ("ABSOLUTE CLOCK") FRMTIM=FRMTIM+LFRM GOTO 2 C****************************************************************** 999 CONTINUE STOP END [\]. POINT@DAT 0.8600000E+03 0.4120000E+04 0.8600000E+03 0.4380000E+04 0.8600000E+03 0.4530000E+04 0.8600000E+03 0.4720000E+04 0.8600000E+03 0.4940000E+04 0.8600000E+03 0.5150000E+04 0.8600000E+03 0.5380000E+04 0.8600000E+03 0.5590000E+04 0.8600000E+03 0.5810000E+04 0.8600000E+03 0.5980000E+04 0.8600000E+03 0.6050000E+04 0.8600000E+03 0.6200000E+04 0.8600000E+03 0.6410000E+04 0.1500000E+04 0.4120000E+04 0.1500000E+04 0.4380000E+04 0.1500000E+04 0.4530000E+04 0.1500000E+04 0.4710000E+04 0.1500000E+04 0.4920000E+04 0.1500000E+04 0.5130000E+04 0.1500000E+04 0.5350000E+04 0.1500000E+04 0.5560000E+04 0.1500000E+04 0.5770000E+04 0.1500000E+04 0.5950000E+04 0.1500000E+04 0.6010000E+04 0.1500000E+04 0.6200000E+04 0.1500000E+04 0.6550000E+04 0.2120000E+04 0.4120000E+04 0.2120000E+04 0.4380000E+04 0.2120000E+04 0.4530000E+04 0.2120000E+04 0.4720000E+04 0.2120000E+04 0.4920000E+04 0.2120000E+04 0.5130000E+04 0.2120000E+04 0.5340000E+04 0.2120000E+04 0.5550000E+04 0.2120000E+04 0.5760000E+04 0.2120000E+04 0.5940000E+04 0.2120000E+04 0.6010000E+04 0.2120000E+04 0.6200000E+04 0.2120000E+04 0.6600000E+04 0.2620000E+04 0.4120000E+04 0.2620000E+04 0.4380000E+04 0.2620000E+04 0.4530000E+04 0.2620000E+04 0.4720000E+04 0.2620000E+04 0.4910000E+04 0.2620000E+04 0.5120000E+04 0.2620000E+04 0.5330000E+04 0.2620000E+04 0.5530000E+04 0.2620000E+04 0.5730000E+04 0.2620000E+04 0.5920000E+04 0.2620000E+04 0.6010000E+04 0.2620000E+04 0.6200000E+04 0.2620000E+04 0.6550000E+04 0.2980000E+04 0.4120000E+04 0.2980000E+04 0.4440000E+04 0.2980000E+04 0.4530000E+04 0.2980000E+04 0.4720000E+04 0.2980000E+04 0.4910000E+04 0.2980000E+04 0.5130000E+04 0.2980000E+04 0.5320000E+04 0.2980000E+04 0.5530000E+04 0.2980000E+04 0.5720000E+04 0.2980000E+04 0.5910000E+04 0.2980000E+04 0.6030000E+04 0.2980000E+04 0.6220000E+04 0.2980000E+04 0.6510000E+04 0.3440000E+04 0.4120000E+04 0.3440000E+04 0.4340000E+04 0.3440000E+04 0.4450000E+04 0.3440000E+04 0.4650000E+04 0.3440000E+04 0.4870000E+04 0.3440000E+04 0.5110000E+04 0.3440000E+04 0.5340000E+04 0.3440000E+04 0.5550000E+04 0.3440000E+04 0.5770000E+04 0.3440000E+04 0.6000000E+04 0.3440000E+04 0.6130000E+04 0.3440000E+04 0.6280000E+04 0.3440000E+04 0.6630000E+04 0.3860000E+04 0.4120000E+04 0.3860000E+04 0.4250000E+04 0.3860000E+04 0.4370000E+04 0.3860000E+04 0.4610000E+04 0.3860000E+04 0.4850000E+04 0.3860000E+04 0.5100000E+04 0.3860000E+04 0.5360000E+04 0.3860000E+04 0.5580000E+04 0.3860000E+04 0.5830000E+04 0.3860000E+04 0.6070000E+04 0.3860000E+04 0.6240000E+04 0.3860000E+04 0.6340000E+04 0.3860000E+04 0.6770000E+04 0.4150000E+04 0.4100000E+04 0.4150000E+04 0.4180000E+04 0.4150000E+04 0.4310000E+04 0.4150000E+04 0.4770000E+04 0.4150000E+04 0.4830000E+04 0.4150000E+04 0.5090000E+04 0.4150000E+04 0.5360000E+04 0.4150000E+04 0.5600000E+04 0.4150000E+04 0.5860000E+04 0.4150000E+04 0.6120000E+04 0.4150000E+04 0.6310000E+04 0.4150000E+04 0.6370000E+04 0.4150000E+04 0.6780000E+04 0.4440000E+04 0.4060000E+04 0.4440000E+04 0.4150000E+04 0.4440000E+04 0.4260000E+04 0.4440000E+04 0.4550000E+04 0.4440000E+04 0.4820000E+04 0.4440000E+04 0.5090000E+04 0.4440000E+04 0.5340000E+04 0.4440000E+04 0.5650000E+04 0.4440000E+04 0.5930000E+04 0.4440000E+04 0.6220000E+04 0.4440000E+04 0.6390000E+04 0.4440000E+04 0.6500000E+04 0.4440000E+04 0.6810000E+04 0.4710000E+04 0.4010000E+04 0.4710000E+04 0.4120000E+04 0.4710000E+04 0.4200000E+04 0.4710000E+04 0.4520000E+04 0.4710000E+04 0.4810000E+04 0.4710000E+04 0.5080000E+04 0.4710000E+04 0.5310000E+04 0.4710000E+04 0.5680000E+04 0.4710000E+04 0.5990000E+04 0.4710000E+04 0.6300000E+04 0.4710000E+04 0.6460000E+04 0.4710000E+04 0.6610000E+04 0.4710000E+04 0.6840000E+04 0.4890000E+04 0.7000000E+04 0.5070000E+04 0.7150000E+04 0.4880000E+04 0.4000000E+04 0.4880000E+04 0.4090000E+04 0.4880000E+04 0.4180000E+04 0.4880000E+04 0.4510000E+04 0.4880000E+04 0.4810000E+04 0.4880000E+04 0.5080000E+04 0.4880000E+04 0.5310000E+04 0.4880000E+04 0.5690000E+04 0.4880000E+04 0.5980000E+04 0.4880000E+04 0.6260000E+04 0.4880000E+04 0.6400000E+04 0.4880000E+04 0.6550000E+04 0.4880000E+04 0.6760000E+04 0.5050000E+04 0.6930000E+04 0.5170000E+04 0.7070000E+04 0.5010000E+04 0.3960000E+04 0.5010000E+04 0.4070000E+04 0.5010000E+04 0.4140000E+04 0.5010000E+04 0.4500000E+04 0.5010000E+04 0.4810000E+04 0.5010000E+04 0.5080000E+04 0.5010000E+04 0.5300000E+04 0.5010000E+04 0.5690000E+04 0.5010000E+04 0.5980000E+04 0.5010000E+04 0.6220000E+04 0.5010000E+04 0.6350000E+04 0.5010000E+04 0.6500000E+04 0.5010000E+04 0.6700000E+04 0.5150000E+04 0.6880000E+04 0.5260000E+04 0.7020000E+04 0.5130000E+04 0.3950000E+04 0.5130000E+04 0.4050000E+04 0.5130000E+04 0.4120000E+04 0.5130000E+04 0.4490000E+04 0.5130000E+04 0.4800000E+04 0.5130000E+04 0.5070000E+04 0.5130000E+04 0.5300000E+04 0.5130000E+04 0.5690000E+04 0.5130000E+04 0.5970000E+04 0.5130000E+04 0.6170000E+04 0.5130000E+04 0.6300000E+04 0.5130000E+04 0.6430000E+04 0.5130000E+04 0.6630000E+04 0.5250000E+04 0.6800000E+04 0.5330000E+04 0.6960000E+04 0.5290000E+04 0.3940000E+04 0.5290000E+04 0.4040000E+04 0.5290000E+04 0.4100000E+04 0.5290000E+04 0.4490000E+04 0.5290000E+04 0.4810000E+04 0.5290000E+04 0.5040000E+04 0.5290000E+04 0.5280000E+04 0.5290000E+04 0.5670000E+04 0.5290000E+04 0.5950000E+04 0.5290000E+04 0.6140000E+04 0.5290000E+04 0.6260000E+04 0.5290000E+04 0.6390000E+04 0.5290000E+04 0.6570000E+04 0.5340000E+04 0.6770000E+04 0.5440000E+04 0.6930000E+04 0.5750000E+04 0.3790000E+04 0.5750000E+04 0.3930000E+04 0.5750000E+04 0.4020000E+04 0.5750000E+04 0.4340000E+04 0.5750000E+04 0.4620000E+04 0.5750000E+04 0.4860000E+04 0.5750000E+04 0.5090000E+04 0.5750000E+04 0.5430000E+04 0.5750000E+04 0.5680000E+04 0.5750000E+04 0.5870000E+04 0.5750000E+04 0.6030000E+04 0.5750000E+04 0.6150000E+04 0.5750000E+04 0.6260000E+04 0.6360000E+04 0.3680000E+04 0.6370000E+04 0.3800000E+04 0.6400000E+04 0.3890000E+04 0.6440000E+04 0.4120000E+04 0.6480000E+04 0.4350000E+04 0.6510000E+04 0.4540000E+04 0.6540000E+04 0.4750000E+04 0.6590000E+04 0.5000000E+04 0.6620000E+04 0.5200000E+04 0.6660000E+04 0.5400000E+04 0.6700000E+04 0.5610000E+04 0.6720000E+04 0.5660000E+04 0.6730000E+04 0.5830000E+04 0.7910000E+04 0.3330000E+04 0.7930000E+04 0.3410000E+04 0.7970000E+04 0.3560000E+04 0.8020000E+04 0.3770000E+04 0.8060000E+04 0.3880000E+04 0.8110000E+04 0.4210000E+04 0.8160000E+04 0.4420000E+04 0.8210000E+04 0.4650000E+04 0.8260000E+04 0.4850000E+04 0.8310000E+04 0.5060000E+04 0.8350000E+04 0.5280000E+04 0.8360000E+04 0.5340000E+04 0.8440000E+04 0.5660000E+04 0.9010000E+04 0.2910000E+04 0.9040000E+04 0.3000000E+04 0.9100000E+04 0.3150000E+04 0.9190000E+04 0.3370000E+04 0.9270000E+04 0.3590000E+04 0.9370000E+04 0.3820000E+04 0.9440000E+04 0.4040000E+04 0.9540000E+04 0.4260000E+04 0.9620000E+04 0.4490000E+04 0.9720000E+04 0.4710000E+04 0.9800000E+04 0.4940000E+04 0.9840000E+04 0.5050000E+04 0.1005000E+05 0.5570000E+04 0.1041000E+05 0.1400000E+04 0.1045000E+05 0.1470000E+04 0.1051000E+05 0.1570000E+04 0.1057000E+05 0.1700000E+04 0.1067000E+05 0.1880000E+04 0.1071000E+05 0.1980000E+04 0.1105000E+05 0.2800000E+04 0.1120000E+05 0.2900000E+04 0.1137000E+05 0.3200000E+04 0.1164000E+05 0.3710000E+04 0.1182000E+05 0.4050000E+04 0.1186000E+05 0.4140000E+04 0.1208000E+05 0.4520000E+04 0.1146000E+05 0.2600000E+03 0.1149000E+05 0.3100000E+03 0.1154000E+05 0.3900000E+03 0.1175000E+05 0.7200000E+03 0.1199000E+05 0.1050000E+04 0.1214000E+05 0.1240000E+04 0.1236000E+05 0.1540000E+04 0.1292000E+05 0.2420000E+04 0.1298000E+05 0.2500000E+04 0.1322000E+05 0.2890000E+04 0.1351000E+05 0.3330000E+04 0.1356000E+05 0.3400000E+04 0.1370000E+05 0.3620000E+04 0.5000000E+76 0.5000000E+76 0.5000000E+76 0.5000000E+76 [\]. PRINT@JOB $JOB 20(010) PRINT JOB /MCDOUGALL $UIC $PUP T 16 _ 17 SYMBL JOB $PUP T 16 _ 17 SYMDIS SRC $PUP T 16 _ 17 YCHECK SRC $PUP T 16 _ 17 XCHECK SRC $PUP T 16 _ 17 ERASE SRC $PUP T 16 _ 17 COPY JOB $PUP T 16 _ 17 CHOR2 SRC $PUP T 16 _ 17 COMPL JOB $PUP T 16 _ 17 SYMDI SRC $PUP T 16 _ 17 SYMBOL SRC $PUP T 16 _ 17 COLM SRC $PUP T 16 _ 17 COLM JOB $PUP T 16 _ 17 DATA SRC $PUP T 16 _ 17 DATA2 SRC $END $JOB FLUSH $END [\]. PRTPRDSRC SUBROUTINE PRTPRD(IMOD,MOD) C****** CALCULATES PAC PARTIAL PRODUCT MATRIXS COMMON/ACCUM/RAC(3,3,15) COMMON/PROD/PAC(3,3,15) C IF (IMOD.EQ.0) GOTO 100 DO 69 K=1,3 DO 69 J=1,3 SUM=0. DO 68 I=1,3 68 SUM=PAC(J,I,IMOD)*RAC(I,K,MOD)+SUM 69 PAC(J,K,MOD)=SUM GOTO 99 C C ABSOLUTE & ACCUMULATED ANGLES ARE EQ FOR HIPS 100 DO 101 K=1,3 DO 101 J=1,3 101 PAC(J,K,MOD)=RAC(J,K,MOD) 99 RETURN END [\]. PRTSUMSRC SUBROUTINE PRTSUM(MODULE,ISON) C SUBROUTINE TO CALCULATE PARTIAL SUMS PSUM COMMON/CENTS/C(3,15) COMMON/PROD/PAC(3,3,15) COMMON/SUMIT/PSUM(3,16,5) COMMON/LINKIT/ISTRT,LINKS(6,15) C IF(MODULE.EQ.0)GO TO 99 C PICK OUT PARENT IMOD=LINKS(1,MODULE) I=1 10 I=I+1 NUMSON=LINKS(I,MODULE) IF(NUMSON.NE.ISON)GO TO 10 NUMSON=I-1 IF(IMOD.EQ.0)GO TO 12 I=1 11 I=I+1 INSON=LINKS(I,IMOD) IF(INSON.NE.MODULE)GO TO 11 INSON=I-1 GO TO 13 12 INSON=1 IMOD=16 13 DO 69 J=1,3 SUM=0. DO 68 I=1,3 68 SUM=PAC(J,I,MODULE)*C(I,ISON)+SUM 69 PSUM(J,MODULE,NUMSON)=SUM DO 67 I=1,3 67 PSUM(I,MODULE,NUMSON)=PSUM(I,MODULE,NUMSON)+PSUM(I, 2IMOD,INSON) 99 RETURN END [\]. RDCON@SRC C------------------------------------------------------------------------- SUBROUTINE RDCON(FPBT) C (AUTHOR: GLEN MCDOUGALL) C -READS SYMBOL FILE,ASSIGNS LOC ROT ANG. FOR MODS. C -USES RH COORD SYSTEM C------------------------------------------------------------------------- C INTEGER COL,SUP,DIR,LEV,ROT,FLX INTEGER FRMTIM,FTIM,FDUR INTEGER LEFT,MOD,NFRMS(15) C REAL DIRA(14),FANG(3,15),JMPSPN(4,2),RTTHIP(3,3) REAL LRPY(6,15) C COMMON /SYMBOL/ COL,SUP,DIR,LEV,ROT,FLX,BDUR,BTIM COMMON /FANGC/ FANG,FRMTIM,NFRMS COMMON /LRPYC/LRPY,LFRM COMMON/IOLU/IOT,IOP,IOD C DATA DIRA /0.,0.,90.,270.,0.,360.,180.,180.,45.,315., 1135.,225.,0.,0./ C************************************************************************* C PROCESS LAST SYMBOL READ IN BEFORE READING NEXT ONE IF (FRMTIM .GT. 0) GOTO 15 10 READ (IOD,11) COL,SUP,DIR,LEV,ROT,FLX,BDUR,BTIM 11 FORMAT (6I3,2F7.2) IF (COL .EQ. 998) GOTO 10 IF (COL .NE. 999) GOTO 15 FRMTIM=-1 GOTO 999 15 CONTINUE FTIM=IFIX(BTIM*FPBT) C ONLY PROCESS SYMBOLS STARTING AT FRMTIM IF (FTIM.GT.FRMTIM) GOTO 999 C LEFT=0 FLXA=FLX*30 FDUR=IFIX(BDUR*FPBT) C C BODY PARTS: LH LA HI LL LS RS RL CH RA RH HD C MODULES : 8 6,7 1 13,14,15 10,11,12 2 3,4 5 9 20 GOTO ( 800,600,100,1300,1301,1001,1000,200,300,500,900),COL C C UPPER ARM ************************************************ 600 LEFT=1 300 CONTINUE MOD=3+3*LEFT FANG(1,MOD)=ROT*45 FANG(2,MOD)=DIRA(DIR+1) FANG(3,MOD)=(LEV*45)-(FLXA*.5) NFRMS(MOD)=FDUR C WATCH FOR LIMB STRAIGHT UP OR DOWN VAL=ABS(LRPY(3,MOD)) C WRITE(IOP,) VAL,LRPY(3,MOD) IF (.NOT.((VAL.EQ.0.).OR.(VAL.EQ.180.))) GOTO 310 LRPY(2,MOD)=FANG(2,MOD) C WRITE(IOP,) FANG(2,MOD),LRPY(2,MOD) 310 CONTINUE C LOWER ARM *************************************** 700 CONTINUE 400 CONTINUE MOD=MOD+1 FANG(3,MOD)=FLXA NFRMS(MOD)=FDUR GOTO 10 C HAND ******************************************* 800 LEFT=1 500 CONTINUE MOD=5+3*LEFT FANG(1,(MOD-1))=ROT*45 FANG(3,MOD)=FLXA-90. NFRMS(MOD)=FDUR GOTO 10 C HIPS (TORSO) ********************************* 100 CONTINUE IF (.NOT.((DIR.EQ.12).OR.(DIR.EQ.13))) GOTO 10 MOD=1 FANG(MOD,2)=ROT*45 C TRRHIP(?,?)=? GOTO 10 C CHEST ****************************************** 200 CONTINUE GOTO 10 C HEAD ******************************************* 900 CONTINUE GOTO 10 C UPPER LEG ************************************ 1300 LEFT=1 1301 CONTINUE 1000 CONTINUE 1001 CONTINUE MOD=10+3*LEFT FANG(1,MOD)=ROT*45 FANG(2,MOD)=DIRA(DIR+1) FANG(3,MOD)=(LEV*45)+(FLXA*.5) NFRMS(MOD)=FDUR C LOWER LEG ********************************* 1400 CONTINUE 1100 CONTINUE MOD=MOD+1 FANG(3,MOD)=-FLXA NFRMS(MOD)=FDUR C FOOT ******************************************* 1500 CONTINUE 1200 CONTINUE MOD=MOD+1 C FANG(2,MOD)=90 GOTO 10 C C***************************************************************** C FIND LFRM = MIN NON ZERO VALU OF NFRMS 999 NLOW=1000 DO 5000 M=1,15 LOW=NFRMS(M) IF (LOW.EQ.0) GOTO 5000 IF(NLOW.GT.LOW) NLOW=LOW 5000 CONTINUE LFRM=NLOW C********************************************************************* RETURN END [\]. RDCONVSRC SUBROUTINE RDCONV(FPBT) C READS SYMBOL FILE,ASSIGNS LOC.ROT.ANG. FOR 1-4 MODS. C INTEGER COL,SUP,DIR,LEV,ROT,FLX INTEGER FTIM,FDUR INTEGER FTIMN,FDURN C REAL AR (9) C COMMON/SYMRS0/SYMRS(4,4),NM,FDUR,FTIM COMMON/SYMRS1/SYMRSN(4,4),NMN,FDURN,FTIMN COMMON/IOLU/IOT,IOP,IOD C************************************************************************* C STORE NEW VALUES IN SYMRSN WRITE(IOT,100) 100 FORMAT(' ENTER BTIM BDUR NMN') READ (IOT,) BTIM,BDUR,NMN FDURN=IFIX(BDUR*FPBT) FTIMN=IFIX(BTIM*FPBT) I=0 10 I=I+1 WRITE(IOT,115) 115 FORMAT(' ENTER M RO PI YA') READ (IOT,) M,RO,PI,YA C SYMRSN(I,1)=M SYMRSN(I,2)=RO SYMRSN(I,3)=PI SYMRSN(I,4)=YA C IF (I .LT.NMN) GOTO 10 C******************************************************************************* 999 RETURN END T D [\]. ROTATESRC SUBROUTINE ROTATE(PI,YA,RO,MOD) C ROTATES A MODULE ABOUT PRINCIPAL AXII C IN (Y, Z, X) ORDER C (RH COORD SYSTEM: +X=RIGHT,+Y=UP,+Z=TOWARDS YOU) DIMENSION SAVE(3,3),AM(3,3) COMMON/ACCUM/ RAC(3,3,15) DATA RD/.017145/ II=0 5 II=II+1 GOTO (20,30,10,99,99),II C****** ROLL MATRIX 10 IF (RO .EQ. 0.) GOTO 5 AM(1,1)=1. AM(2,1)=0. AM(3,1)=0. AM(1,2)=0. AM(2,2)=COS(RO*RD) IF(RO.LT.0.0)AM(2,2)=-AM(2,2) AM(3,2)=SIN(RO*RD) AM(1,3)=0. AM(2,3)=-AM(3,2) AM(3,3)=AM(2,2) GOTO 40 C****** PITCH MATRIX 20 IF (PI .EQ. 0.) GOTO 5 AM(1,1)=COS(PI*RD) IF(PI.LT.0.0)AM(1,1)=-AM(1,1) AM(2,1)=0. AM(1,3)=SIN(PI*RD) AM(1,2)=0. AM(2,2)=1. AM(3,2)=0. AM(3,1)=-AM(1,3) AM(2,3)=0. AM(3,3)=AM(1,1) GOTO 40 C****** YAW MATRIX 30 IF (YA .EQ. 0.) GOTO 5 3 AM(1,1)=COS(YA*RD) IF(YA.LT.0.0)AM(1,1)=-AM(1,1) AM(2,1)=SIN(YA*RD) AM(3,1)=0. AM(1,2)=-AM(2,1) AM(2,2)=AM(1,1) AM(3,2)=0. AM(1,3)=0. AM(2,3)=0. AM(3,3)=1. C****** SAVE RAC 40 CONTINUE DO 68 K=1,3 DO 68 I=1,3 68 SAVE(I,K)=RAC(I,K,MOD) C** C WRITE (6,) I,AM,SAVE C** C****** FORM NEW RAC DO 69 K=1,3 DO 69 I=1,3 SUM=0. DO 67 J=1,3 67 SUM=SAVE(I,J)*AM(J,K)+SUM 69 RAC(I,K,MOD)=SUM GOTO 5 99 RETURN END [\]. RUN1@@JOB $JOB 20(010) RUN1 JOB / MCDOUGALL $UIC $REM SYMDIS $INS SYMDIS $REQ SYMDIS $REM SYMDIS $END [\]. SAV@@@SRC DIMENSION PTS(4,20),IVECT(200) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX I2B=1 I2E=2 XMAX=20. XMIN=-20.0 YMIN=-20. YMAX=20.0 PTS(1,1)=-5.0 PTS(2,1)=-5.0 PTS(1,2)=5.0 PTS(2,2)=5.0 PTS(1,3)=-5.9 PTS(1,4)=10.0 PTS(3,1)=-5.0 PTS(4,1)=5.0 PTS(3,2)=5.0 PTS(4,2)=-5.0 CALL CLEAR(.FALSE.) CALL VECTOR(1,PTS,I2B,I2E,IVECT,1,LAST,7,1,.FALSE.) CALL DRAW(IVECT,1,LAST) DO 200 I=1,5000 200 B=3*8*9*9*9*9/9999 STOP END [\]. SCHOR1SRC C **************************************************************** C CHOR1 (LABAN SYMBOL INPUT PHASE) FOR C *CHOREO* INTERACTIVE DANCE FACILITY (AUTHOR -G.A.MCDOUGALL) C -STORES EACH SYMBOL AS 8 NUMBERS IN "DANC1 SRC" FILE C -CALLS SYMBLD TO DISPLAY SYMBOL C -CALLS SORTB TO SORT SYMBOLS INTO READ ORDER C **************************************************************** C REAL BLEN,BTIM,SBTIM(11),TBAR(50,2) REAL XMIN,XMAX,YMIN,YMAX REAL XA,XB,YA,YB C INTEGER COL,SUP,DIR,LEV,ROT,FLX,CHG INTEGER X,Y,XC,YC INTEGER TBARI(50,6),EBAR,EDAN INTEGER BAR,CONT,FLIP,BPB INTEGER STP,SIB,TSIB,CH,ZR,FNM(2) INTEGER SORTV1(50),SORTV2(50),ZXY(3) INTEGER FIRST,LAST,TAG,MODE,BEGIN,END,IVECT(400) INTEGER INT,ISPACE,FNC INTEGER IOT,IOP,IOD C COMMON/SYMBOL/ COL,SUP,DIR,LEV,ROT,FLX,BLEN,BTIM,SBTIM COMMON/SORTC/SORTV1,SORTV2,SIB COMMON/VECT/ FIRST,LAST,TAG,MODE,BEGIN,END,IVECT COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX COMMON/FRAME/ XA,XB,YA,YB COMMON/IOLU/ IOT,IOP,IOD C DATA TBARI,TBAR/300*0,100*0./ C C INIT LUN ASST'S **************************************** C INIT LUN ASSIGNMENTS IOT=4 IOP=6 IOD=17 C WRITE(IOT,9) WRITE (IOT,10) WRITE (IOT,11) C 9 FORMAT('- ******** CHOREO INTERACTIVE DANCE FACILITY *********') 10 FORMAT(' YOU MAY 1-CREATE,2-CHANGE THE CHOREO "DANC1 SRC" FILE') 11 FORMAT(' ENTER YOUR CHOICE AS A NUMBER') READ (IOT,) CH IF (CH .EQ. 3) GOTO 2000 IF (CH .EQ.2) GOTO 28 C CREATE -DELETE OLD FILE (IF PRESENT) 23 CALL DELETE (IOD,5HDANC1,3HSRC,IEV) 25 CALL WAITFR (IEV) IF (IEV) 999,25,27 27 WRITE (IOT,15) C 15 FORMAT( ' ENTER BEATS/BAR (3 OR 4)') READ (IOT,) BPB C OPEN THE DANCE FILE 26 CALL ENTER (IOD,5HDANC1,3HSRC,IEV) 22 CALL WAITFR (IEV) IF (IEV) 999,22,60 C C CHANGE SYMBOLS IN EXISTING FILE 28 CONTINUE C CALL SEEK(IOD,5HDANC1,3HSRC,IEV) C CALL EDITD (NOT CODED YET) GOTO 1000 C INITIALIZATION SECTION ********************************** 60 CONTINUE C INIT SCREEN LIMITS XMIN=0. XMAX=20. YMIN=0. YMAX=20. XA=0. XB=20. YA=0. YB=20. C INITIALIZE ARRAYS USED TO BUILD SYMBOLS CALL ARINIT C INIT GEN PURPOSE VARS EBAR = 998 EDAN =999 ZR = 0 RZR=0. BAR = 1 SIB=0 TSIB=0 BBTIM=0. DO 64 I=1,11 64 SBTIM(I)=0.0 WRITE(IOT,65) C 65 FORMAT(' NOW -ENTER SYMBOLS FROM THE ACOUSTIC TABLET') C****************************************************************** C SYMBOL PARAMETER ASSIGNMENT SECTION 80 CONTINUE CALL CLEAR(.TRUE.) CALL COLM 81 COL=0 SUP = 0 DIR = 0 LEV = 0 ROT = 0 FLX = 0 BLEN = 0.0 BTIM = 0.0 GOTO 90 C ********************************* MANUAL INPUT SECTION ***** C90 WRITE (IOT,190) 190 FORMAT(' CO SU DI LE RO FL BL 1=EOS/2=EOB/3=EOD') READ (IOT,) COL,SUP,DIR,LEV,ROT,FLX,BLEN,III GOTO (200,300,1000),III GOTO 90 C ************************* A.T. INPUT SECTION ****************** 90 CALL GETBLT(25,0,ZXY,IEV) CALL WAITFR(IEV) XC=ZXY(3) YC=ZXY(2) X=17-XC/56 Y=1+YC/56 WRITE (IOT,) X,Y IF ((X.GT.16).OR.(Y.GT.16)) GOTO 90 C **************************************************************** C SET THE PARAMETER GOTO (90,100,90,110,90,120,90,130,140,150,90,160,90, * 170,180,90),X C SET ** COL ** 100 IF ((Y.EQ.1).OR.(Y.GE.13)) GOTO 90 COL=Y-1 GOTO 90 C SET ** SUP ** 110 IF ((Y.EQ.1).OR.(Y.EQ.16)) GOTO 90 SUP=Y-1 GOTO 90 C SET ** DIR ** 120 IF((Y.EQ.1).OR.(Y.GE.15)) GOTO 90 DIR=Y-1 GOTO 90 C SET ** LEV OR ROT ** 130 GOTO (90,131,131,131,90,90,90,90,132,133,134,90,90, * 90,90,90),Y 131 LEV=Y-1 GOTO 90 132 ROT=8 GOTO 90 133 ROT=1 GOTO 90 134 ROT=2 GOTO 90 C SET ** ROT ** 140 IF (Y.EQ.9) GOTO 143 IF (Y.EQ.11) GOTO 144 GOTO 90 143 ROT=7 GOTO 90 144 ROT=3 GOTO 90 C SET ** FLX OR ROT ** 150 GOTO (90,151,151,151,151,151,151,90,152,153,154,90,90, * 90,90,90),Y 151 FLX=Y-1 GOTO 90 152 ROT=6 GOTO 90 153 ROT=5 GOTO 90 154 ROT=4 GOTO 90 C SET ** EOS, EOB, EOD ** 160 GOTO (90,161,161,161,161,161,161,161,161,90,90,200,90, * 300,90,1000),Y C SET ** BLEN ** 161 BLEN=BLEN+(Y-1)*.125 IF (LEN.GT.BPB) LEN=BPB C GOTO 90 C C CHANGE SYMBOL (NOT CODED YET) 170 GOTO 90 C EDIT,REPLAY NOT CODED YET 180 GOTO 90 C *********************************************************** C SYMBOL ERROR MSGS 200 CONTINUE IF (COL .GT. 0) GOTO 204 WRITE (IOT,201) 201 FORMAT (' COL IS ALSO REQUIRED') GOTO 90 204 IF (.NOT.((DIR.NE.0).AND.((LEN.EQ.0).OR.(LEV.EQ.0)))) GOTO 206 WRITE(IOT,205) 205 FORMAT(' LENGTH, LEVEL ARE ALSO REQUIRED') GOTO 90 C ***************************************************************** C SYMBOL DISPLAY & STORE SECTION 206 CONTINUE SIB=SIB+1 TAG=SIB C BUILD AND DISPLAY SYMBOL CALL SYMBLD WRITE (IOT,) SIB C CALC SYMBOL START TIME (BEAT UNITS) C UPDATE RELATIVE (WRT BAR) START TIME SBTIM(COL)=SBTIM(COL)+BLEN BTIM=BBTIM+SBTIM(COL) WRITE(IOT,) COL,SUP,DIR,LEV,ROT,FLX,BLEN,BTIM,BBTIM,SBTIM(COL) C STORE SORT ORDER SORTV1(SIB) = (BTIM*1000)+COL C STORE SYMBOL IN TEMP ARRAY (MUST BE SORTED BEFORE FILED) TBARI(SIB,1) = COL TBARI(SIB,2) = SUP TBARI(SIB,3) = DIR TBARI(SIB,4) = LEV TBARI(SIB,5) = ROT TBARI(SIB,6) = FLX TBAR(SIB,1) = BLEN TBAR(SIB,2) = BTIM C GOTO 81 C************************************************************************ C END OF BAR PROCESSING 300 CONTINUE C SORT THE SYMBOLS BY COL WITHIN STARTING LOCATION WRITE (IOP,) (SORTV1(I),I=1,SIB) CALL SORTB WRITE (IOP,) (SORTV2(I),I=1,SIB) C FILE HEADER & SYMBOL RECORDS IN ORDER WRITE (IOD,500) EBAR,BAR,SIB,ZR,ZR,ZR,RZR,RZR 500 FORMAT(6I3,2F7.3) DO 320 I=1,SIB IN = SORTV2(I) WRITE (IOD,500) TBARI(IN,1),TBARI(IN,2),TBARI(IN,3),TBARI(IN,4), 1TBARI(IN,5),TBARI(IN,6),TBAR(IN,1),TBAR(IN,2) 320 CONTINUE C C UPDATE TOTAL SYMBOLS IN DANCE & BAR # , RESET SIB TSIB = TSIB + SIB SIB = 0 BAR = BAR + 1 C UPDATE ABSOLUTE BAR START TIME, & RELATIVE (WRT BAR) C SYMBOL START TIME BBTIM=BBTIM+BPB DO 310 I=1,11 310 SBTIM(I)=AMAX1(0.0,(SBTIM(I)-BPB)) GOTO 80 C*************************************************************** C END OF DANCE PROCESSING 1000 WRITE (IOD,500) EDAN,BAR,TSIB,ZR,ZR,ZR,RZR,RZR C CLOSE THE DANCE FILE 999 CONTINUE WRITE (IOT,) IEV CALL CLOSE (IOD,5HDANC1,3HSRC,IEV) CALL WAITFR(IEV) WRITE(IOT,)IEV C 2000 CONTINUE WRITE(IOT,2001) C 2001 FORMAT(' TO VIEW ANIMATION OF DANCE -ENTER "CHOR2"') READ(IOT,) CH STOP END [\]. SCHOR2SRC C------------------------------------------------------------------- C CHOR2 (ANIMATION PHASE) FOR *CHOREO* INTERACTIVE DANCE FACILITY C (AUTHOR: GLEN MCDOUGALL) C -CALLS RDCON TO READ "DANC1 SRC" FILE & CONVERT TO MODULE ANGLES C -COORDINATES TIMING FOR MODULE MOVEMENT C -CALLS MOVINC TO BUILD & DISPLAY EACH FRAME C---------------------------------------------------------------------- INTEGER FRMTIM,FTIM,FDUR1,FTIMN,FDURN INTEGER NFRMS(15) REAL LRPY,FANG(3,15) C COMMON/LRPYC/LRPY(6,15),LFRM COMMON/FANGC/FANG,FRMTIM,NFRMS COMMON/IOLU/ IOT,IOP,IOD COMMON/EYCEP/EYE(3),CEN(3),UP(3) COMMON/LINKIT/ ISTRT,LINKS(6,15) COMMON/LIMITS/XMIN,XMAX,YMIN,YMAX C****************************************************************** C TERMINAL & PRINTER LUN'S IOT=4 IOP=6 IOD=17 C SET UP VIEWING PARAMETERS XMIN=-30. XMAX=30. YMIN=-30. YMAX=30. EYE(1)=0. EYE(2)=0. EYE(3)=0. CEN(1)=0. CEN(2)=0. CEN(3)=0. UP(1)=0. UP(2)=10. UP(3)=0. DIST=60. 4 WRITE(IOT,5) 5 FORMAT(' ENTER VIEW: 1-FRONT,2=TOP,3-LSIDE') READ(IOT,) I IF((I.GT.3).OR.(I.LT.1)) GOTO 4 EYE(I)=DIST CALL ROTER CALL CLEAR(.TRUE.) C***************************************************************** ISTRT=1 NEW=0 C READ IN MOD & LINK INFO & DISPLAY CHARLIE (AT ATTENTION) CALL INPUTS LFRM=1 CALL MOVINC(DIST,NEW) C INIT -FOR EACH MODULE:# OF MOVEMENT FRAMES C & LOCAL ROLL, PITCH, YAW ROTATIONS & FINAL ANGLES DO 21 M=1,15 DO 21 L=1,6 NFRMS(M)=0 LRPY(L,M)=0. IF (L.GT.3) GOTO 21 FANG(L,M)=0. 21 CONTINUE WRITE(IOT,19) 19 FORMAT(' ENTER TEMPO (IN BEATS PER MIN.)') READ(IOT,)TMPO FPBT=1440./TMPO C INIT PARAMETERS JUMP=0 FRMTIM=0 C OPEN THE DANCE FILE FOR FUTURE READS CALL SEEK(IOD,5HDANC1,3HSRC,IEV) 22 CALL WAITFR(IEV) IF (IEV) 999,22,23 23 CONTINUE WRITE (IOT,) IEV,FPBT C*************************************************************************** C READ & CONVERT DANCE FILE SYMBOLS INTO MOD ANGLES 2 CONTINUE C CALL RDCON (FPBT) C END OF DANCE ? IF (FRMTIM.LT.0) GOTO 999 C CALC INCR ANGLES FOR NEW MOVEMENTS DO 15 MOD=1,15 FDUR1=NFRMS(MOD) IF (FDUR1.EQ.0) GOTO 15 LRPY(4,MOD)=(FANG(1,MOD)-LRPY(1,MOD))/FDUR1 LRPY(5,MOD)=(FANG(2,MOD)-LRPY(2,MOD))/FDUR1 LRPY(6,MOD)=(FANG(3,MOD)-LRPY(3,MOD))/FDUR1 15 CONTINUE C***************************************************************** WRITE(IOP,)FRMTIM,LFRM,FDUR1 DO 398 I=1,15 IF (NFRMS(I).EQ.0) GOTO 398 WRITE (IOP,) NFRMS(I) 398 CONTINUE DO 399 I=1,15 DO 399 J=1,6 IF (LRPY(J,I).EQ.0) GOTO 399 WRITE (IOP,) LRPY(J,I) 399 CONTINUE C***************************************************************** C DISPLAY CHARLIE FOR LFRM FRAMES C USING LRPY ANGLES C CALL MOVINC(DIST,NEW) C UPDATE FRMTIM ("ABSOLUTE CLOCK") FRMTIM=FRMTIM+LFRM C****************************************************************** C UPDATE START ANGLES AND # OF REMAINING FRAMES DO 11 M=1,15 C IF NO RECENT MOD MOVMNT -IGNORE IF (NFRMS(M).EQ.0) GOTO 11 C UPDATE START ANGS LRPY(1,M)=FANG(1,M) LRPY(2,M)=FANG(2,M) LRPY(3,M)=FANG(3,M) C UPDATE # REMAINING FRMS NFRMS(M)=NFRMS(M)-LFRM C IF MOD MOVMNT ENDS ZERO INCR ANGS FOR MOD IF (NFRMS(M).NE.0) GOTO 11 LRPY(4,M)=0. LRPY(5,M)=0. LRPY(6,M)=0. 11 CONTINUE C*************************************************************** DO 498 I=1,15 IF (NFRMS(I) .EQ.0) GOTO 498 WRITE (IOP,) NFRMS(I) 498 CONTINUE DO 499 I=1,15 DO 499 J=1,6 IF(LRPY(J,I).EQ.0) GOTO 499 WRITE(IOP,) LRPY(J,I) 499 CONTINUE GOTO 2 C*************************************************************** C**************************************************************** 999 CONTINUE C CLOSE THE DANCE FILE CALL CLOSE (IOD,5HDANC1,3HSRC,IEV) 88 CALL WAITFR(IEV) IF (IEV) 89,88,89 89 WRITE (IOT,) IEV STOP END [\]. SCOLM@SRC SUBROUTINE COLM C** SUBROUTINE TO DISPLAY COLUMNS REAL ARR(4,32),INC C REAL XMIN,XMAX,YMIN,YMAX C REAL XA,XB,YA,YB C INTEGER FIRST,LAST,TAG,MODE,BEGIN,END,IVECT(400) INTEGER INT,ISPACE,FCN C COMMON/VECT/ FIRST,LAST,TAG,MODE,BEGIN,END,IVECT COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX COMMON/FRAME/ XA,XB,YA,YB C C** COLUMN LINE DEFINITIONS IOT=4 ARR(1,1)=2.8 ARR(2,1)=2 ARR(3,1)=19.3 ARR(4,1)=2 C** DO 10 I=2,13 ARR(1,I)=2.8+1.5*(I-2) ARR(2,I)=2 ARR(3,I)=2.8+1.5*(I-2) ARR(4,I)=18 10 CONTINUE C** DO 20 I=14,29 INC=0 IF ((I.EQ.17).OR.(I.EQ.21).OR.(I.EQ.25).OR.(I.EQ.29)) INC=.1 ARR(1,I)=10.2-INC ARR(2,I)=2+(I-13) ARR(3,I)=10.4+INC ARR(4,I)=2+(I-13) 20 CONTINUE C*********** CALL DSPLAY(7,IGET,IERR) WRITE(IOT,) IGET,IERR CALL VECTOR (1,ARR,1,29,IVECT,1,LAST,7,1,.FALSE.) WRITE(IOT,) LAST CALL DSPLAY (3,51,IERR) WRITE(IOT,) IERR WRITE(IOT,) LAST CALL DSPLAY (6,51,IERR,IVECT,1,LAST) WRITE(IOT,) IERR,LAST RETURN END [\]. SORTB@SRC SUBROUTINE SORTB C SORTS SYMBOLS OF BAR & STORES WRITE ORDER IN SORTV2 C (ALLOWS SYMBOLS TO BE INPUT IN ANY ORDER FROM A.T.) C INTEGER SIB,SORTV1(50),SORTV2(50) COMMON/SORTC/SORTV1,SORTV2,SIB C DO 10 J=1,SIB LOWV=99999 DO 20 I=1,SIB IF (SORTV1(I).GE.LOWV) GOTO 20 LOWI=I LOWV=SORTV1(I) 20 CONTINUE SORTV2(J)=LOWI SORTV1(LOWI)=99999 10 CONTINUE RETURN END [\]. SRDCONSRC SUBROUTINE RDCON(FPBT) C READS SYMBOL FILE,ASSIGNS LOC ROT ANG. FOR MODS. C INTEGER COL,SUP,DIR,LEV,ROT,FLX INTEGER FRMTIM,FTIM,FDUR INTEGER LEFT,MOD,NFRMS(15) C REAL DIRA(14),FANG(3,15),JMPSPN(4,2),RTTHIP(3,3) REAL LRPY(6,15) C COMMON /SYMBOL/ COL,SUP,DIR,LEV,ROT,FLX,BDUR,BTIM COMMON /FANGC/ FANG,FRMTIM,NFRMS COMMON /LRPYC/LRPY,LFRM COMMON/IOLU/IOT,IOP,IOD C DATA DIRA /0.,0.,-90.,90.,0.,0.,-180.,180.,-45.,45., 1-135.,135.,0.,0./ C************************************************************************* C PROCESS LAST SYMBOL READ IN BEFORE READING NEXT ONE IF (FRMTIM .GT. 0) GOTO 15 10 READ (IOD,11) COL,SUP,DIR,LEV,ROT,FLX,BDUR,BTIM 11 FORMAT (6I3,2F7.2) IF (COL .EQ. 998) GOTO 10 IF (COL .NE. 999) GOTO 15 FRMTIM=-1 GOTO 999 15 CONTINUE FTIM=IFIX(BTIM*FPBT) C ONLY PROCESS SYMBOLS STARTING AT FRMTIM IF (FTIM.GT.FRMTIM) GOTO 999 C LEFT=0 FLXA=FLX*30 FDUR=IFIX(BDUR*FPBT) WRITE(IOP,) BTIM,FRMTIM,FTIM C C 20 GOTO(500,300,100,1000,1001,1301,1300,200,600,800,900),COL C UPPER ARM ************************************************ 600 LEFT=1 300 CONTINUE MOD=3+3*LEFT FANG(1,MOD)=ROT*45 FANG(2,MOD)=DIRA(DIR+1) FANG(3,MOD)=(LEV*45)-(FLXA*.5) NFRMS(MOD)=FDUR C WATCH FOR LIMB STRAIGHT UP OR DOWN VAL=ABS(LRPY(3,MOD)) WRITE(IOP,) VAL,LRPY(3,MOD) IF (.NOT.((VAL.EQ.0.).OR.(VAL.EQ.180.))) GOTO 310 LRPY(2,MOD)=DIRA(DIR+1) WRITE(IOP,) FANG(2,MOD),LRPY(2,MOD) 310 CONTINUE C LOWER ARM *************************************** 700 CONTINUE 400 CONTINUE MOD=MOD+1 FANG(3,MOD)=FLXA NFRMS(MOD)=FDUR GOTO 10 C HAND ******************************************* 800 LEFT=1 500 CONTINUE MOD=5+3*LEFT FANG(1,(MOD-1))=ROT*45 FANG(3,MOD)=FLXA-90. NFRMS(MOD)=FDUR GOTO 10 C HIPS (TORSO) ********************************* 100 CONTINUE IF (.NOT.((DIR.EQ.12).OR.(DIR.EQ.13))) GOTO 10 MOD=1 FANG(MOD,2)=ROT*45 C TRRHIP(?,?)=? GOTO 10 C CHEST ****************************************** 200 CONTINUE GOTO 10 C HEAD ******************************************* 900 CONTINUE GOTO 10 C UPPER LEG ************************************ 1300 LEFT=1 1301 CONTINUE 1000 CONTINUE 1001 CONTINUE MOD=10+3*LEFT FANG(1,MOD)=ROT*45 FANG(2,MOD)=DIRA(DIR+1) FANG(3,MOD)=(LEV*45)+(FLXA*.5) NFRMS(MOD)=FDUR C LOWER LEG ********************************* 1400 CONTINUE 1100 CONTINUE MOD=MOD+1 FANG(3,MOD)=-FLXA NFRMS(MOD)=FDUR C FOOT ******************************************* 1500 CONTINUE 1200 CONTINUE MOD=MOD+1 C FANG(2,MOD)=90 GOTO 10 C C***************************************************************** C FIND LFRM = MIN NON ZERO VALU OF NFRMS 999 NLOW=1000 DO 5000 M=1,15 LOW=NFRMS(M) IF (LOW.EQ.0) GOTO 5000 IF(NLOW.GT.LOW) NLOW=LOW 5000 CONTINUE LFRM=NLOW C********************************************************************* RETURN END [\]. SSORTBSRC SUBROUTINE SORTB C****** SORTS SYMBOLS OF BAR INTO READ ORDER C INTEGER SIB,SORTV1(50),SORTV2(50) COMMON/SORTC/SORTV1,SORTV2,SIB C DO 10 J=1,SIB LOWV=99999 DO 20 I=1,SIB IF (SORTV1(I).GE.LOWV) GOTO 20 LOWI=I LOWV=SORTV1(I) 20 CONTINUE SORTV2(LOWI)=J SORTV1(LOWI)=99999 10 CONTINUE RETURN END [\]. SYMBINSRC C SYMBIN *INPUTS SYMBOL STRINGS INTO DANC1 SRC FILE INTEGER COL,SUP,DIR,LEV,ROT,FLX REAL BLEN,BTIM CALL ENTER(17,5HDANC1,3HSRC,IEV) 10 CALL WAITFR(IEV) IF (IEV) 1000,10,11 11 CONTINUE WRITE(4,20) 20 FORMAT(' CO SU DI LV RT FL BL BTM') READ (4,) COL,SUP,DIR,LEV,ROT,FLX,BLEN,BTIM IF (COL .EQ. 999) GOTO 999 12 FORMAT(6I3,2F7.3) WRITE(17,12) COL,SUP,DIR,LEV,ROT,FLX,BLEN,BTIM GOTO 11 999 CALL CLOSE (17,5HDANC1,3HSRC,IEV) 90 CALL WAITFR(IEV) IF (IEV) 1000,90,91 91 CONTINUE 1000 CONTINUE STOP END [\]. SYMBL@JOB $JOB 20(010) SYMBL JOB SPRINGY $UIC $TKB NRM,UL:F4LIB} LABAN} 200} GRAFIX} CHOR2,YCHECK,XCHECK,SYMDIS,COLM,SYMBOL,ERASE} } $REM LABAN $INS LABAN $REQ LABAN $END $JOB FLUSH $END [\]. SYMBLDSRC SUBROUTINE SYMBLD C****** BUILDS SYMBOLS AND DISPLAYS THEM ON THE LABAN STAFF C REAL SBTIM(11),BLEN,BTIM REAL ARR(4,32),SHPAR(2,11,13),FLXAR(4,7),SUPLAR(4,6,2) REAL SUPTAR(4,17) C INTEGER COL,SUP,DIR,LEV,ROT,FLX INTEGER MODE,BEGIN,END,IVECT(400),FIRST INTEGER LAST,INT,ISPACE,FCN,TAG INTEGER FLIP,I,STP C COMMON/SYMBOL/COL,SUP,DIR,LEV,ROT,FLX,BLEN,BTIM,SBTIM COMMON/ARRAY/ ARR,SHPAR,FLXAR,SUPLAR,SUPTAR COMMON/VECT/ FIRST,LAST,TAG,MODE,BEGIN,END,IVECT COMMON/LIMITS/ XMIN,XMAX,YMIN,YMAX COMMON/FRAME/ XA,XB,YA,YB COMMON/IOLU/ IOT,IOP,IOD C C****** TRANSLATE SYMBOL SHAPE TO SCREEN ,SET INTENSITY TX = 2.8 + 1.5*(COL-1) TY = 2.0 + 4. * SBTIM(COL) FIRST=1 BEG=1 END=1 INT = 7 ISPACE = 1 SHRT = 0.0 IF (DIR.EQ.0) GOTO 9 IF (FLX.NE.0) SHRT = .167 DO 5 I=1,11 ARR(1,I)=TX+.1*(I-1) ARR(2,I)=TY+SHPAR(1,I,DIR)*(4*BLEN)+SHRT ARR(3,I)=TX+.1*(I-1) ARR(4,I)=TY+SHPAR(2,I,DIR)*(4*BLEN) 5 CONTINUE INT=3+(LEV-1)*2 END=END+11 9 IF (ROT.EQ.0) GOTO 100 C****** TRANSLATE ROTATION PINS GOTO (10,20,30,40,50,60,70,80),ROT 10 X=.0 Y=.3 GOTO 90 20 X=.3 Y=.3 GOTO 90 30 X=.3 Y=.0 GOTO 90 40 X=.3 Y=-.3 GOTO 90 50 X=.0 Y=-.3 GOTO 90 60 X=-.3 Y=-.3 GOTO 90 70 X=-.3 Y=.0 GOTO 90 80 X=-.3 Y=.3 90 ARR(1,END)=TX+.5 ARR(2,END)=TY+SHRT+.5*BLEN*4 ARR(3,END)=TX+X+.5 ARR(4,END)=TY +Y+ SHRT+.5*BLEN*4 END = END +1 100 IF (FLX.EQ.0) GOTO 200 C****** TRANSLATE FLEXION SYMBOLS STP = FLX + 1 DO 110 I=1,STP ARR(1,END)=TX+FLXAR(1,I) ARR(2,END)=TY+FLXAR(2,I) ARR(3,END)=TX+FLXAR(3,I) ARR(4,END)=TY+FLXAR(4,I) 110 END=END+1 C****** TRANSLATE SUPPORT SYMBOLS 200 IF (SUP.EQ.0) GOTO 300 IF ((SUP.EQ.7).OR.(SUP.EQ.8)) GOTO 275 FLIP =0 IF (0.EQ.(MOD(SUP,2))) FLIP=1 IF (SUP.GE.10) GOTO 250 ARR(1,END)=TX+SUPLAR(1,1,1)-FLIP ARR(2,END)=TY+SUPLAR(2,1,1) ARR(3,END)=TX+SUPLAR(3,1,1)-FLIP ARR(4,END)=TY+SUPLAR(4,1,1) END = END+1 IF (SUP.LE.6) STP=6 IF (SUP.LE.4) STP=3 IF (SUP.LE.2) STP = 2 DO 210 I=2,STP ARR(1,END)=TX+SUPLAR(1,I,1)-FLIP ARR(2,END)=TY+SUPLAR(2,I,1) ARR(3,END)=TX+SUPLAR(3,I,1) ARR(4,END)=TY+SUPLAR(4,I,1) 210 END = END +1 GOTO 300 C****** LEG SUPPORT 250 ARR(1,END)=TX+SUPLAR(1,I,2)-FLIP ARR(2,END)=TY+SUPLAR(2,I,2) ARR(3,END)=TX+SUPLAR(3,I,2)-FLIP ARR(4,END)=TY+SUPLAR(4,I,2) END = END +1 IF (SUP.LE.14) STP = 6 IF (SUP.LE.12) STP = 3 IF (SUP.LE.10) STP = 2 DO 260 I=2,STP ARR(1,END)=TX+SUPLAR(1,I,2)-FLIP ARR(2,END)=TY+SUPLAR(2,I,2) ARR(3,END)=TX+SUPLAR(3,I,2) 260 ARR(4,END)=TY+SUPLAR(4,I,2) END=END+STP+1 GOTO 300 C****** TORSO SUPPORT 275 STP = 12 IF (SUP.EQ.8) STP = 17 DO 280 I=1,STP ARR(1,END)=TX+SUPTAR(1,I) ARR(2,END)=TY+SUPTAR(2,I) ARR(3,END)=TX+SUPTAR(3,I) ARR(4,END)=TY+SUPTAR(4,I) 280 END=END+1 END = END + STP+1 C****** DISPLAY COMPLETED SYMBOL (HI INT. FOR ROT,FLX,SUP LNS) 300 END=END-1 CALL VECTOR(1,ARR,BEGIN,END,IVECT,FIRST,LAST,INT,ISPACE,.FALSE.) CALL DSPLAY(3,TAG,IERR) CALL DSPLAY(6,TAG,IERR,IVECT,1,LAST) RETURN END [\]. TBLD@@SRC CLOSE OPEN TBLD JOB [\]. TEST@@SRC C****** TEST FOR FILE OPRNS INTEGER RECS,FNM(3) REAL COL,SUP,DIR,ROT,FLX,LEV REAL LEN,POS DATA FNM/2HDA,2HNC,1H1/ RECS=15 CALL SEEK (15,5HDANC1,3HSRC,IEV) 50 CALL WAITFR(IEV) IF (IEV) 1001,50,51 51 DO 10 M=1,RECS 52 READ (15,) COL,SUP,DIR,LEV,ROT,FLX,LEN,POS IF (COL.EQ.999.) GOTO 52 WRITE (4,) COL,SUP,DIR,LEV,ROT,FLX,LEN,POS 10 CONTINUE 999 CALL CLOSE(15,5HDANC1,3HSRC,IEV) 1000 CALL WAITFR (IEV) IF (IEV) 1001,1000,1002 1001 WRITE (4,) IEV 1002 STOP END [\]. TRAN@@SRC SUBROUTINE TRAN C ERASE THIS TOP [\]. USR/P2EDT 2 0 3 1 0 0 1.000 0.000 2 0 3 2 0 0 1.000 1.000 2 0 3 3 0 0 1.000 2.000 2 0 5 1 0 0 1.000 3.000 2 0 5 2 0 0 1.000 4.000 2 0 5 3 0 0 1.000 5.000 2 0 7 1 0 0 1.000 6.000 2 0 7 2 0 0 1.000 7.000 2 0 7 3 0 0 1.000 8.000 2 0 9 1 0 0 1.000 9.000 2 0 9 2 0 0 1.000 10.000 2 0 9 3 0 0 1.000 11.000 2 0 11 1 0 0 1.000 12.000 2 0 11 2 0 0 1.000 13.000 2 0 11 3 0 0 1.000 14.000 2 0 11 2 0 0 1.000 15.000 998 0 0 0 0 0 0.000 0.000 999 0 0 0 0 0 0.000 0.000 [\]. VARI0@DAT 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.0000000E+00 0.3400000E+01 0.7437500E+00 0.1245700E+01 0.1314500E-12 0.2684200E+01 0.6886000E+00 0.3479000E+01 0.4958200E+00 0.3397600E+01 0.3785000E+00 0.3403100E+01-0.3764200E-01 0.3512300E+01-0.3676100E+00 0.3346300E+01-0.4771800E+00 0.3579700E+01-0.5885200E+00 0.3726700E+01-0.8485200E+00 0.3734200E+01-0.4834300E+00 0.3541300E+01-0.3320100E+00 0.1290400E+01-0.5425500E+00 0.1523500E+01 0.2297400E+00 0.9460500E+00 0.1705300E-12 0.1491500E+01-0.6159000E-03 0.3391500E+01-0.1127600E-01 0.3510300E+01-0.2564500E+00 0.3583400E+01-0.4382000E+00 0.3462800E+01-0.3935900E+00 0.3601200E+01-0.3722300E+00 0.3457700E+01-0.8028000E-01 0.3323900E+01 0.8045300E-01 0.2895600E+01 0.6774700E-01 0.2726500E+01 0.1780900E+00 0.7276300E+00 0.1777500E+00 0.6293500E+00 0.6821200E-12 0.4599500E+00 0.3979000E-12 0.1387000E+01-0.3393500E+00 0.2237400E+01-0.2768800E+00 0.2411700E+01-0.3520100E+00 0.2473700E+01-0.4249500E+00 0.2659300E+01-0.3656700E+00 0.2459500E+01-0.1234800E+00 0.2591700E+01-0.1189200E+00 0.2566700E+01 0.4681000E-01 0.2310400E+01 0.1852300E+00 0.2231600E+01-0.9042200E-01 0.6526900E+00-0.3518200E-01 0.6810000E+00-0.7126700E-01 0.6965800E+00 0.9094900E-12 0.1710900E+01 0.9826800E-01 0.2478400E+01-0.8201100E-01 0.2545900E+01-0.1786900E+00 0.2519700E+01-0.1721600E+00 0.2447600E+01-0.1000100E+00 0.2649100E+01-0.1831800E+00 0.2465800E+01-0.2290800E-01 0.2382900E+01 0.5047900E-02 0.2394900E+01-0.2776600E+00 0.1951300E+01-0.8331500E-01 0.6669000E+00 0.7080600E-01 0.6623600E+00 0.6462000E-01 0.7542700E+00 0.4547500E-12 0.1808600E+01-0.5518700E-01 0.2682000E+01 0.2456300E-01 0.2729300E+01 0.1531900E-01 0.2772900E+01 0.7424900E-01 0.2895100E+01 0.2042300E-01 0.2780000E+01 0.1472400E+00 0.2943500E+01 0.1051800E+00 0.2981500E+01 0.4103100E-01 0.3053500E+01 0.2095800E+00 0.2256900E+01-0.7091800E-01 0.8267600E+00 0.3426400E+00 0.8902400E+00 0.2630300E+00 0.6605700E+00-0.1860800E-01 0.1606500E+01-0.1094000E-01 0.2306400E+01-0.7986500E-01 0.2295200E+01-0.1265500E-01 0.2152600E+01 0.3990800E-01 0.2030300E+01 0.3137900E+00 0.2362600E+01 0.4869600E+00 0.2469000E+01 0.7025600E+00 0.2989300E+01 0.7485700E+00 0.3120800E+01 0.3169900E+00 0.2472300E+01 0.4995000E+00 0.9871600E+00 0.3106700E+00 0.8942400E+00 0.1889200E+00 0.6162500E+00-0.6375000E-01 0.1357300E+01-0.6220100E-01 0.1908100E+01 0.1432900E+00 0.1680200E+01 0.8453600E-01 0.1554800E+01 0.2451600E+00 0.1864300E+01 0.4349800E+00 0.1567800E+01 0.8428100E+00 0.2153300E+01 0.1522100E+01 0.2740700E+01 0.1626500E+01 0.3380300E+01 0.1183800E+01 0.2841600E+01-0.3172300E-01 0.9890800E+00 0.4175900E+00 0.1166500E+01 0.8045100E-01 0.5155900E+00-0.8286200E-01 0.1218200E+01 0.5229500E-01 0.1659700E+01 0.3848100E-01 0.1926700E+01 0.5088300E+00 0.1680300E+01 0.3989800E+00 0.1606100E+01 0.5438500E+00 0.1758900E+01 0.7945100E+00 0.1228100E+01 0.1530900E+01 0.2177800E+01 0.2728100E+01 0.3403800E+01 0.2651200E+01 0.4232200E+01 0.1366300E+01 0.1526500E+01 0.4430800E+00 0.1440500E+01 0.1543400E+00 0.5191700E+00-0.7079500E-01 0.9596600E+00-0.1112600E+00 0.1140200E+01 0.9413100E-01 0.1198100E+01 0.7170400E-01 0.1250900E+01 0.4873700E+00 0.1283100E+01 0.4680500E+00 0.1038900E+01 0.1071300E+01 0.1316500E+01 0.1150800E+01 -0.1034500E+00 0.2656100E+01 0.1929800E+01 0.5238000E+01 0.5016500E+01 0.2548300E+01 0.4276000E+01 0.2912000E+01 0.1409500E-01-0.1409500E-01 0.6008000E+00 0.1373200E+01 0.2898700E+01 0.3623400E+01 0.1253000E+00-0.2088300E-01 0.6620300E+00 0.1428400E+00 0.7419800E+00-0.2427200E-01 0.7186200E+00 0.3662100E+00 0.8429700E+00 0.2602800E+00 0.7006300E+00 0.6059000E+00 0.8727300E+00 0.8264300E+00 0.7316800E+00 0.1636800E+01 -0.1059700E+00 0.1700700E+01 -0.6172200E-03 0.3091700E+01 0.4811700E+01 0.3794100E+01 0.4592200E+01 0.7191500E+01 0.4139600E+01 0.5069000E+01 0.6527000E+00 0.4920600E+01 0.3148300E+01 0.3423700E+01 0.4931300E+00-0.9862600E-01 0.2823500E+00-0.7967600E-01 0.6544500E+00 0.3364900E+00 0.5743300E+00 0.3463200E+00 0.7108200E+00 0.5956100E+00 0.5878500E+00 0.3447800E+00 0.6492400E+00 0.1261000E+01 0.6916900E+00 0.1364000E+01 0.1900100E+00 0.1511800E+01 0.3390900E-01 0.2872200E+01 0.1066900E+01 0.2936800E+01 0.3282200E+01 0.4026500E+01 0.3502900E+01 0.5153600E+01 0.2308200E+01 0.4847600E+01 0.2401200E+01 0.3159500E+01 -0.3313000E+00 0.2366400E-01 0.4843700E+00 0.1206300E+00 0.4269100E+00-0.8259600E-01 0.6338300E+00 0.4387400E+00 0.6287100E+00 0.2837400E+00 0.7336000E+00 0.8164400E+00 0.5426000E+00 0.1204000E+01 0.9872600E+00 0.1797000E+01 0.3400900E+00 0.1275100E+01 0.5576800E+00 0.3360700E+01 -0.5508300E+00 0.2812300E+01 -0.5929700E+00 0.2662900E+01 0.1176600E+01 0.1122700E+01 0.1712700E+00 0.2229300E+01 0.5792100E+00 0.1059700E+01 0.4614200E+00-0.1190800E+00 0.3419000E+00-0.3863200E-01 0.7487100E+00 0.5780900E+00 0.1218500E+01 0.9337700E+00 0.1529200E+01 0.1098900E+01 0.1711200E+01 0.1049100E+01 0.2059800E+01 0.1506600E+01 0.2033400E+01 0.1459100E+01 0.2228200E+01 0.1249000E+01 -0.7275200E+00 0.2784600E+01 -0.1322600E+01 0.2469200E+01 -0.1184600E+01 0.3018300E+01 0.1434800E+01 0.1434800E+01 0.7176200E+00 0.2152900E+01 0.3091000E+00 0.1133400E+01 0.2805100E+00-0.6816000E-01 0.9503800E+00-0.3720600E-01 0.1408300E+01-0.8339400E+00 0.1570600E+01-0.8821800E+00 0.1724200E+01-0.4638300E+00 0.2204800E+01 0.1337100E+00 0.2203700E+01 0.2764800E-01 0.2060000E+01 0.6715400E-01 0.1758500E+01 0.8053900E+00 0.8164200E+00 0.1340800E+01 -0.4385200E+00 0.2472300E+01 -0.1072300E+01 0.1628800E+01 -0.1565900E+01 0.8046800E+00 0.8984100E+00-0.1913300E+00 0.2547400E+01-0.8677800E+00 0.2770600E+01-0.1072000E+00 0.3126000E+01-0.2761400E+00 0.3137600E+01-0.1144000E+01 0.2856100E+01-0.8810400E+00 0.2910800E+01-0.1453100E+00 0.2827800E+01-0.2246400E+00 0.2258000E+01-0.4916300E+00 0.2007500E+01-0.9019200E+00 0.5367600E+00-0.1704000E+00 0.7075200E+00-0.1573500E+00 0.8205700E+00-0.1830300E+00 0.1590000E+01-0.4619900E+00 0.2908700E+01-0.7062400E+00 0.3242000E+01-0.1235200E+01 0.2992800E+01-0.1096700E+01 0.2906800E+01-0.1370000E+01 0.3265400E+01-0.1193000E+01 0.3251700E+01-0.1402900E+01 0.3110100E+01-0.1335800E+01 0.3435800E+01-0.7283700E+00 0.3636900E+01-0.2755500E+00 0.3003500E+01-0.4440100E+00 0.9427700E+00-0.1811600E+00 0.8431400E+00-0.6602900E-01 0.1076800E+01-0.8312700E+00 0.1377500E+01-0.6475500E+00 0.3463100E+01-0.4485300E+01 0.2747900E+01-0.4465500E+01 0.2633400E+01-0.4113800E+01 0.1510700E+01-0.3450500E+01 0.3516300E+01-0.2044500E+01 0.3482100E+01-0.1994000E+01 0.3233700E+01-0.1948800E+01 0.3352200E+01-0.1613600E+01 0.3158000E+01-0.1212600E+01 0.8038800E+00-0.3310000E+00 0.8852000E+00-0.2772300E+00 0.2403700E+01-0.2599900E+01 0.2519000E+01-0.4291100E+01 0.2212400E+01-0.5396700E+01 0.2850300E+01-0.5216200E+01 0.3349300E+01-0.5205000E+01 0.3075200E+01-0.4409200E+01 0.7599500E+00-0.2212000E+01 0.5159100E+01-0.1580200E+01 0.5690200E+01-0.3182600E+01 0.5951700E+01-0.2620200E+01 0.4885200E+01-0.1775200E+01 0.1546400E+01-0.3813100E+00 0.1378400E+01-0.7364200E+00 0.3025900E+01-0.3285300E+01 0.3025900E+01-0.4639900E+01 0.4665700E+01-0.6411400E+01 0.5887900E+01-0.4777200E+01 0.6392600E+01-0.3479300E+01 0.5624900E+01-0.2535400E+01 0.7447600E+00-0.2962000E+01 0.3135600E+01-0.3870400E+00 0.6681600E+01-0.9455500E+00 0.7106400E+01-0.1608600E+01 0.5700300E+01-0.1153700E+01 0.1490900E+01-0.5463000E+00 0.1490900E+01-0.8282600E+00 [\]. XTEST@SRC CALL COLM STOP END [\].