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 MENU(A,B,-1) CALL MENU(C,D,-1) CALL BOX(NUM,INTRP) 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=0 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,20 READ(5,9)BEATS(K) DO 8 J=1,7 8 READ(5,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=K 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=-1 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 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