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
