C PROGRAM TO MAKE BLOCK DIAGRAMS AND OTHER SIMILAR CHARTS. C AVAILABLE FOR USE ON THE CHARTS ARE: C BOXES C TRIANGLES C CIRCLES/ARCS C POINTS C LINES/VECTORS C ARROWHEADS C TEXT C INTEGER X,Y,ICOUNT,PLACE,X1,Y1,X2,Y2,TYPE,START(300) INTEGER Q,FINISH(300),VALUE,DIF,FINAL,CTYPE,BTYPE,TTYPE REAL LINE DIMENSION X(3),Y(3), BOX(100,4), TRIANGLE(100,6), CIRCLE(100,6) DIMENSION POINT(100,2), LINE(500,4), ADOWN(100,2), ARIGHT(100,2) DIMENSION AUP(100,2), ALEFT(100,2),TEXT(300,2),TYPE(300),LTYPE(500) DIMENSION CTYPE(100),ANGLE(100),RADIUS(100),ANGS(100) DIMENSION BTYPE(100),TTYPE(100) BYTE ESC,CSI CHARACTER*80 POSITION,LETTER,PNAME,FNAME,ONAME,QUOTE(500),TEMPC CHARACTER*2 SIZE CHARACTER*6 RESULT CHARACTER*3 ANSWER CHARACTER*1 ARCSIZE ESC=27 CSI=155 ICOUNT=0 C KEEPS COUNT OF THE NUMBER OF BOXES IN THE DIAGRAM. J=0 C KEEPS COUNT OF THE NUMBER OF TRIANGLES IN THE DIAGRAM. K=0 C KEEPS COUNT OF THE NUMBER OF CIRCLES IN THE DIAGRAM. L=0 C KEEPS COUNT OF THE NUMBER OF LINES IN THE DIAGRAM. M=0 C KEEPS COUNT OF THE NUMBER OF POINTS IN THE DIAGRAM. ND=0 C KEEPS COUNT OF THE NUMBER OF DOWNWARD FACING ARROW HEADS IN THE DIAGRAM. NR=0 C KEEPS COUNT OF THE NUMBER OF RIGHT FACING ARROW HEADS IN THE DIAGRAM. NU=0 C KEEPS COUNT OF THE NUMBER OF UPWARD FACING ARROW HEADS IN THE DIAGRAM. NL=0 C KEEPS COUNT OF THE NUMBER OF LEFT FACING ARROW HEADS IN THE DIAGRAM. X(1)=0 Y(1)=0 C INITIALIZES THE VALUES OF X(1) AND Y(1) TO ZERO. S=0 X1=0 Y1=0 X2=799 Y2=479 C S=0 INDICATES THAT THERE HAS BEEN NO SCROLL COMMAND AS OF YET. C THE SCREEN BOUNDARIES ARE INDICATED BY X1,Y1,X2, AND Y2. LINENUM=0 Q=0 C LINENUM INDICATES THE TOTAL NUMBER OF TEXT LINES IN THE DIAGRAM, WHERE C Q INDICATES THE TOTAL NUMBER OF QUOTES.(THAT IS, THE NUMBER OF TIMES C THE WRITE COMMAND HAS BEEN CALLED UPON.) PRINT *,'DO YOU WANT TO ADD TO AN OLD DIAGRAM?(YES OR NO)' READ(5,2) ANSWER 2 FORMAT(A3) IF (ANSWER .EQ. 'YES') THEN PRINT*,'WHAT IS THE NAME OF THE FILE?(NAME MUST END WITH .DAT) $ (PUT THE ANSWER IN QUOTES)' READ(5,*)FNAME PRINT*,'WHAT IS THE NAME OF THE PLOTTING FILE?(NAME MUST END' PRINT*,'WITH .FOR) (PUT THE ANSWER IN QUOTES)' READ(5,*)PNAME PRINT*,'WHAT IS THE NAME OF THE OBJECT ARRAY FILE? (NAME' PRINT*,'MUST END WITH .DAT) (PUT THE ANSWER IN QUOTES)' READ(5,*)ONAME OPEN(UNIT=4,NAME=FNAME,TYPE='OLD') OPEN(UNIT=7,NAME=PNAME,TYPE='OLD') OPEN(UNIT=8,NAME=ONAME,TYPE='OLD') OPEN(UNIT=9,NAME=ONAME,TYPE='NEW') C TO READ IN THE TYPE AND POSITION OF THE OBJECTS OF THE DIAGRAM. C EACH DIFFERENT TYPE OF OBJECT IS STORED IN AN ARRAY. READ(8,*) ICOUNT,J,K,L,M,ND,NR,NU,NL,Q,LINENUM READ(8,*)((BOX(TEMPX,TEMPY), TEMPY=1,4), TEMPX=1,ICOUNT) READ(8,*)((TRIANGLE(TEMPX,TEMPY), TEMPY=1,6), TEMPX=1,J) READ(8,*)((CIRCLE(TEMPX,TEMPY), TEMPY=1,6), TEMPX=1,K) READ(8,*)((POINT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,M) READ(8,*)((LINE(TEMPX,TEMPY), TEMPY=1,4), TEMPX=1,L) READ(8,*)((ADOWN(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,ND) READ(8,*)((ARIGHT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,NR) READ(8,*)((AUP(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,NU) READ(8,*)((ALEFT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,NL) READ(8,*)((TEXT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,Q) READ(8,*)(TYPE(TEMP), TEMP=1,Q) READ(8,13)(QUOTE(TEMP), TEMP=1,LINENUM) READ(8,*)(START(TEMP), TEMP=1,Q) READ(8,*)(FINISH(TEMP), TEMP=1,Q) READ(8,*)(LTYPE(TEMP), TEMP=1,L) READ(8,*)(CTYPE(TEMP), TEMP=1,K) READ(8,*)(ANGLE(TEMP), TEMP=1,K) READ(8,*)(RADIUS(TEMP), TEMP=1,K) READ(8,*)(ANGS(TEMP), TEMP=1,K) READ(8,*)(BTYPE(TEMP), TEMP=1,ICOUNT) READ(8,*)(TTYPE(TEMP), TEMP=1,J) ELSE IF (ANSWER .EQ. 'NO') THEN PRINT*,'WHAT IS THE NAME OF THE FILE?(NAME MUST END WITH .DAT)' PRINT*,'(PUT THE ANSWER IN QUOTES)' READ(5,*)FNAME PRINT*,'WHAT IS THE NAME OF THE PLOTTING FILE?(NAME MUST END' PRINT*,'WITH .FOR) (PUT THE ANSWER IN QUOTES)' READ(5,*)PNAME PRINT*,'WHAT IS THE NAME OF THE OBJECT ARRAY FILE? (NAME' PRINT*,'MUST END WITH .DAT) (PUT THE ANSWER IN QUOTES)' READ(5,*)ONAME OPEN(UNIT=4,NAME=FNAME,TYPE='NEW') OPEN(UNIT=7,NAME=PNAME,TYPE='NEW') OPEN(UNIT=9,NAME=ONAME,TYPE='NEW') END IF PRINT*,'IS THE SIZE OF THE PAPER A OR B? IF IT IS A, WILL IT BE HELD' PRINT*,'VERTICALLY OR HORIZONTALLY? (ANSWER: VA, HA, OR B)' READ(5,9)SIZE 9 FORMAT(A2) C C INSTRUCTIONS C 1 WRITE(6,95)ESC,'\' PRINT *,'TO MOVE THE CURSOR USE THE ARROW KEYS.' PRINT *,'WHEN THE CURSOR(OR CROSSHAIR) IS IN THE CORRECT POSITION' PRINT*,'(CENTER FOR CIRCLE/ARC,TOP LEFT CORNER FOR SQUARES,VERTEX' PRINT*,'FOR TRIANGLES,EITHER END FOR LINE, AT POSITION OF/FOR' PRINT*,'POINTS AND ARROWHEADS,EITHER 3,2,OR 1 SHIFTED UP ARROWS' PRINT*,'ABOVE THE POSITION OF THE LARGE,MEDIUM OR SMALL' PRINT *,'PRINT(RESPECTIVELY)) PRESS ONE OF THE FOLLOWING KEYS:' PRINT *,' B -TO DRAW A BOX' PRINT *,' T -TO DRAW A TRIANGLE' PRINT *,' O -TO DRAW A CIRCLE/ARC' PRINT *,' P -TO DRAW A POINT' PRINT *,' A -TO DRAW A LINE/VECTOR' PRINT *,' D -TO DRAW AN ARROWHEAD FACING DOWN' PRINT *,' R -TO DRAW AN ARROWHEAD FACING TO THE RIGHT' PRINT *,' U -TO DRAW AN ARROWHEAD FACING UP' PRINT *,' L -TO DRAW AN ARROWHEAD FACING TO THE LEFT' PRINT *,' W -TO WRITE TEXT' PRINT *,' S -TO SCROLL THE SCREEN OR REDRAW THE SCREEN' PRINT *,' X -TO ERASE FROM THE DIAGRAM' PRINT *,' I -TO PRINT THE INSTRUCTIONS' PRINT*,'PRESS RETURN TO CONTINUE' READ(5,3)IFLAG,DUMMY PRINT*,' G -TO GO BACK WHERE YOU WERE WITHOUT DRAWING ANYTHING' PRINT *,' E -TO END THE PROGRAM' PRINT*,' ' PRINT*,' ' PRINT*,'THEN MOVE THE CURSOR TO THE OPPOSITE CORNER OF THE BOX,' PRINT*,' THE OTHER END OF THE LINE, OR THE SECOND VERTEX OF' PRINT*,' THE TRIANGLE. THEN, WHEN THE CURSOR IS IN THE CORRECT' PRINT*,' POSITION, PRESS ''G''.' PRINT*,' ' PRINT*,' TO DRAW DASHED LINES OR BOXES, PRESS ''Y'' INSTEAD OF ''G''' PRINT*,' AT THE END OF THE LINE OR BOX.' PRINT*,' ' PRINT*,' THIS STEP MUST THEN BE REPEATED FOR THE THIRD VERTEX OF' PRINT*,' THE TRIANGLE, PRESSING ''G''(FOR A SOLID BORDER) OR ''Y''' PRINT*,' (FOR A DASHED BORDER).' PRINT*,' ' PRINT*,'OR, MOVE THE CURSOR TO THE STARTING POSITION ON THE TEXT AND' PRINT*,'PRESS 1,2, OR 3 FOR SMALL, MEDIUM OR LARGE PRINT' PRINT*,' ' PRINT*,'PRESS RETURN TO CONTINUE' READ(5,3)IFLAG,DUMMY PRINT*,'FOR CIRCLES/ARCS, MOVE THE CURSOR TO A POINT ON THE CIRCLE/ARC' PRINT*,'(INDICATING THE BEGINNING OF THE CIRCLE/ARC, WHICH IS DRAWN' PRINT*,'COUNTER-CLOCKWISE FROM THIS POINT) AND PRESS ''G'',''H'',' PRINT*,'---------------------------------' PRINT*,' ''J'',OR ''K''' PRINT*,' ' PRINT*,' G -WHEN THE STARTING ANGLE<=180 AND THE TOTAL ANGLE<=180' PRINT*,' OR WHEN DRAWING A CIRCLE' PRINT*,' H -WHEN THE STARTING ANGLE<=180 AND THE TOTAL ANGLE>180' PRINT*,' J -WHEN THE STARTING ANGLE>180 AND THE TOTAL ANGLE>180' PRINT*,' K -WHEN THE STARTING ANGLE>180 AND THE TOTAL ANGLE<=180' PRINT*,'THE STARTING ANGLE IS THE ANGLE OF THE BEGINNING OF THE ARC' PRINT*,'MEASURED RELATIVE TO THE HORIZONTAL AXIS COMING FROM THE' PRINT*,'CENTER OF THE ARC. THE TOTAL ANGLE IS THE ANGLE OF THE ARC' PRINT*,'MEASURED RELATIVE TO THE STARTING POSITION.' PRINT*,' ' PRINT*,'THE CURSOR MUST NOW BE MOVED TO THE ENDING POSITION OF THE' PRINT*,'CIRCLE/ARC AND PRESS ''G'' OR ''Y''' PRINT*,' G -FOR SOLID LINED CIRCLE/ARC' PRINT*,' Y -FOR DASHED LINED CIRCLE/ARC' PRINT*,'PRESS RETURN TO CONTINUE' READ(5,3)IFLAG,DUMMY PRINT*,'YOU MAY USE NO MORE THAN 50 CHARACTERS ON EACH LINE OF TEXT.' PRINT*,'TO GET OUT OF THE TEXT MODE OF THE PROGRAM PRESS A SINGLE' PRINT*,'QUOTE MARK.('') SINCE THIS SIGNIFIES THE END OF TEXT,' PRINT*,'YOU CANNOT USE ANY QUOTES IN YOUR LABELS.' PRINT*,' ' PRINT*,'TO ERASE AN OBJECT:' PRINT*,'FIRST PRESS ''X'' ON THE FIRST POINT OF THE OBJECT AS IF' PRINT*,'DRAWING IT. IF THE OBJECT IS A POINT OR AN ARROWHEAD,' PRINT*,'PRESS THE ASSOCIATED LETTER.' PRINT*,'OTHERWISE MOVE THE CURSOR TO THE OTHER POINT ON THE OBJECT' PRINT*,'THEN PRESS:' PRINT *,' B -TO ERASE A BOX' PRINT *,' T -TO ERASE A TRIANGLE(YOU MUST THEN ENTER THE THIRD' PRINT *,' POINT BY PRESSING ''G'')' PRINT *,' O -TO ERASE A CIRCLE/ARC (YOU DON''T NEED TO DRAW THE' PRINT*,' THIRD POINT.)' PRINT *,' P -TO ERASE A POINT' PRINT *,' A -TO ERASE A LINE/VECTOR' PRINT *,' D -TO ERASE AN ARROWHEAD FACING DOWN' PRINT *,' R -TO ERASE AN ARROWHEAD FACING TO THE RIGHT' PRINT *,' U -TO ERASE AN ARROWHEAD FACING UP' PRINT*,'PRESS RETURN TO CONTINUE' READ(5,3)IFLAG,DUMMY PRINT *,' L -TO ERASE AN ARROWHEAD FACING TO THE LEFT' PRINT *,' W -TO ERASE TEXT' PRINT*,' ' PRINT*,' ' PRINT*,' ' PRINT*,' ' PRINT*,'IF, FOR SOME REASON, YOU ENTER AND THEN EXIT THE TEXT MODE' PRINT*,'WITHOUT WRITING ANYTHING, MAKE SURE YOU ERASE THE TEXT' PRINT*,'ANYWAY. IF YOU DON''T, IT MAY MESS UP THE PROGRAM AT A' PRINT*,'LATER TIME WHEN RUNNING IT.' PRINT*,' ' PRINT*,'WHEN IN THE TEXT MODE, YOU CAN USE THE SINGLE SPACE' PRINT*,'DELETE KEY TO MAKE CORRECTIONS ON THE LINE YOU ARE ON.' PRINT*,'ONCE YOU HIT RETURN YOU CAN NOT FIX ANY OF THE PREVIOUS LINES' PRINT*,'USING THE DELETE KEY.' PRINT*,' ' PRINT*,'WHEN ERASING TEXT, YOU MUST POSITION THE CROSSHAIR 1 SHIFTED' PRINT*,'UPWARD ARROW ABOVE THE TEXT FOR SMALL PRINT, 2 SINGLE AND' PRINT*,'2 SHIFTED UPWARD ARROWS ABOVE THE MEDIUM PRINT, AND 4 SINGLE' PRINT*,'AND 3 SHIFTED UPWARD ARROWS ABOVE THE LARGE PRINT.' PRINT*,'PRESS RETURN TO CONTINUE' READ(5,3)IFLAG,DUMMY PRINT*,'WHEN THE TEXT IS ERASED, EVERYTHING THAT WAS ENTERED DURING' PRINT*,'THAT 1 ENTRY AND 1 EXIT OF THE TEXT WRITING PORTION OF THE' PRINT*,'PROGRAM WILL BE ERASED. IT IS THEREFOR ADVISABLE TO' PRINT*,'ENTER THE TEXT A LITTLE AT A TIME.' PRINT*,' ' PRINT*,'MAKE SURE YOU GO SLOW AND DO NOT TYPE ANYTHING UNLESS YOU' PRINT*,'SEE THE CROSSHAIR OR THE TEXT CURSOR' PRINT*,'IF YOU DO GO TOO FAST YOU WILL CAUSE AN INPUT ERROR' PRINT*,'AND END UP LOSING WHAT YOU HAVE DONE.' PRINT*,' ' PRINT*,'IN THIS PROGRAM USE ONLY CAPITAL LETTERS.' PRINT*,' ' PRINT*,'WHEN YOU USE B-SIZE PAPER YOU CAN DRAW IN THE EQUIVALENT' PRINT*,'OF 4 SCREENS BY USING THE SCROLL COMMAND. WHEN USING A-SIZE' PRINT*,'PAPER, (VERTICALLY) ONLY USE THE EQUIVALENT OF 2 SCREENS (LEFT' PRINT*,'TOP AND BOTTOM SCREENS). WHEN USING A-SIZE PAPER,' PRINT*,'(HORIZONTALLY) ONLY USE 1 AND 1/2 SCREENS DOWN AND, 1 AND 1/4' PRINT*,'SCREENS OVER.' PRINT*,' ' PRINT*,' ' PRINT*,'PRESS RETURN TO CONTINUE' READ(5,3)IFLAG,DUMMY PRINT*,'TO AVOID LOSING ADDITIONS TO A DIAGRAM, IT IS ADVISABLE,' PRINT*,'THAT YOU PERIODICALLY END THE PROGRAM (PRESS ''E'') AND' PRINT*,'START UP AGAIN, SO THAT, IF THE SYSTEM SHUTS DOWN, OR' PRINT*,'AN ERROR OCCURS (CAUSING AN ABNORMAL EXIT FROM THE PROGRAM)' PRINT*,'THE WHOLE DIAGRAM WILL NOT BE LOST.' PRINT*,' ' PRINT*,'IF THE TEXT CURSOR (A DIAMOND WITH A CROSS IN IT) APPEARS' PRINT*,'WHEN IT SHOULD NOT BE THERE, OR WHEN TEXT APPEARS WHEN IT' PRINT*,'SHOULD NOT, PRESS THE ''SET-UP'' CONTROL BUTTON, THEN PRESS' PRINT*,'''RECALL''(USING THE ARROW KEYS TO GET THERE) AND THEN PRESS' PRINT*,'''ENTER'',THEN PRESS''SET-UP'' AGAIN ,THEN PRESS THE''LOCK''' PRINT*,'KEY AND THEN RETURN. YOU WILL EITHER STILL BE IN THE PROGRAM,' PRINT*,'OR YOU WILL SEE THE ''$'' SYMBOL SIGNIFYING THAT YOU ARE OUT' PRINT*,'OF THE PROGRAM.' PRINT*,' ' PRINT*,'WHEN YOU UNINTENTIONALLY EXIT FROM THE PROGRAM THE DATA FILE' PRINT*,'WHICH STORES ALL THE DIFFERENT ARRAYS WILL BE EMPTY. THIS' PRINT*,'WILL CAUSE AN ERROR WHEN YOU TRY TO RERUN THE PROGRAM. TO' PRINT*,'AVOID THIS, CHECK THE ARRAY OBJECT DATA FILE BEFORE RERUNNING' PRINT*,'THE PROGRAM. IF THE FILE IS EMPTY, DELETE IT.' PRINT*,'PRESS RETURN TO CONTINUE' READ(5,3)IFLAG,DUMMY 3 FORMAT(Q,F10.3) CALL SETUP(ICOUNT,J,K,L,M,ND,NR,NU,NL,BOX,TRIANGLE,CIRCLE,POINT, $ LINE,ADOWN,ARIGHT,AUP,ALEFT,S,TEXT,Q,START,FINISH,TYPE,QUOTE, $ LTYPE,CTYPE,ANGLE,BTYPE,TTYPE) C SETUP IS A SUBROUTINE WHICH DRAWS ALL THE OBJECTS ON THE SCREEN IN C THE CORRECT POSITIONS. C THE NEXT THREE COMMANDS ARE REGIS COMMANDS. THE FIRST ONE ALLOWS YOU C TO ENTER REGIS. THE SECOND, POSITIONS THE CROSSHAIR, AND THE THIRD, C ACTIVATES THE REPORT POSITION COMMAND WHICH READS IN THE COORDINATES C OF THE POINT AND THE LETTER WHICH WAS PRESSED TO SIGNIFY IT. WRITE(6,91) ESC,'Pp' 50 WRITE(6,*)'P[',X(1),',',Y(1),']' WRITE(6,92) READ(5,93) POSITION LETTER=POSITION(1:1) C CONVERT IS A SUBROUTINE WHICH CONVERTS THE CHARACTER STRING GIVEN BY C THE REPORT POSITION COMMAND INTO TWO DECIMAL NUMBERS, X AND Y. CALL CONVERT(POSITION,X(1),Y(1)) C THE FOLLOWING IF STATEMENTS DETERMINE WHICH PART OF THE PROGRAM SHOULD C BE ENACTED DEPENDING ON WHICH LETTER WAS HIT DURING REPORT POSITION. IF (LETTER .EQ.'G') THEN GOTO 50 ELSE IF (LETTER .EQ.'B') THEN GOTO 100 ELSE IF (LETTER .EQ.'T') THEN GOTO 500 ELSE IF (LETTER .EQ.'O') THEN GOTO 1000 ELSE IF (LETTER .EQ.'P') THEN GOTO 5000 ELSE IF (LETTER .EQ.'A') THEN GOTO 5100 ELSE IF (LETTER .EQ.'D') THEN GOTO 5200 ELSE IF (LETTER .EQ.'R') THEN GOTO 5300 ELSE IF (LETTER .EQ.'U') THEN GOTO 5400 ELSE IF (LETTER .EQ.'L') THEN GOTO 5500 ELSE IF (LETTER .EQ.'X') THEN GOTO 5550 ELSE IF (LETTER .EQ.'W') THEN GOTO 5600 ELSE IF (LETTER .EQ.'S') THEN GOTO 5699 ELSE IF (LETTER .EQ.'I') THEN GOTO 1 ELSE IF (LETTER .EQ.'E') THEN GOTO 5700 ELSE WRITE(6,95)ESC,'/' PRINT*,'INVALID INPUT' DO 4, TIME=1,10000 4 CONTINUE GOTO 1 END IF C THE FOLLOWING COMMANDS WILL DRAW A BOX AT THE POSITION SPECIFIED. C THE COORDINATES OF EACH BOX WILL BE STORED IN THE BOX ARRAY. 100 ICOUNT = ICOUNT+1 WRITE(6,*)'P[',X(1),',',Y(1),']' WRITE(6,92) READ(5,93)POSITION CALL CONVERT(POSITION,X(2),Y(2)) BOX(ICOUNT,1)=X(1) BOX(ICOUNT,2)=X(2) BOX(ICOUNT,3)=Y(1) BOX(ICOUNT,4)=Y(2) X(1)=X(2) Y(1)=Y(2) LETTER=POSITION(1:1) C THIS IF STATEMENT DETERMINES IF THE BOX IS TO HAVE A SOLID BORDER C OR A DASHED ONE. IF BTYPE EQUALS 1, THE BORDER WILL BE SOLID, IF BTYPE C EQUALS 2, THEN THE BORDER WILL BE DASHED. IF (LETTER .EQ.'Y') THEN WRITE(6,*)'P[',BOX(ICOUNT,1),',',BOX(ICOUNT,3),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',BOX(ICOUNT,2),']' WRITE(6,*)'[,',BOX(ICOUNT,4),']' WRITE(6,*)'[',BOX(ICOUNT,1),']' WRITE(6,*)'[,',BOX(ICOUNT,3),']' BTYPE(ICOUNT)=2 GOTO 50 ELSE WRITE(6,*)'P[',BOX(ICOUNT,1),',',BOX(ICOUNT,3),']' WRITE(6,*)'V[',BOX(ICOUNT,2),']' WRITE(6,*)'[,',BOX(ICOUNT,4),']' WRITE(6,*)'[',BOX(ICOUNT,1),']' WRITE(6,*)'[,',BOX(ICOUNT,3),']' BTYPE(ICOUNT)=1 END IF IF (LETTER .EQ.'G') THEN GOTO 50 ELSE IF (LETTER .EQ.'B') THEN GOTO 100 ELSE IF (LETTER .EQ.'T') THEN GOTO 500 ELSE IF (LETTER .EQ.'O') THEN GOTO 1000 ELSE IF (LETTER .EQ.'P') THEN GOTO 5000 ELSE IF (LETTER .EQ.'A') THEN GOTO 5100 ELSE IF (LETTER .EQ.'D') THEN GOTO 5200 ELSE IF (LETTER .EQ.'R') THEN GOTO 5300 ELSE IF (LETTER .EQ.'U') THEN GOTO 5400 ELSE IF (LETTER .EQ.'L') THEN GOTO 5500 ELSE IF (LETTER .EQ.'X') THEN GOTO 5550 ELSE IF (LETTER .EQ.'W') THEN GOTO 5600 ELSE IF (LETTER .EQ.'S') THEN GOTO 5699 ELSE IF (LETTER .EQ.'I') THEN GOTO 1 ELSE IF (LETTER .EQ.'E') THEN GOTO 5700 ELSE WRITE(6,95)ESC,'/' PRINT*,'INVALID INPUT' DO 5, TIME=1,10000 5 CONTINUE GOTO 1 END IF C THE FOLLOWING COMMANDS WILL DRAW A TRIANGLE AT THE POSITION SPECIFIED. C THE COORDINATES OF EACH TRIANGLE WILL BE STORED IN THE TRIANGLE ARRAY. 500 J = J+1 WRITE(6,*)'P[',X(1),',',Y(1),']' WRITE(6,92) READ(5,93)POSITION CALL CONVERT(POSITION,X(2),Y(2)) WRITE(6,*)'P[',X(2),',',Y(2),']' WRITE(6,92) READ(5,93)POSITION CALL CONVERT(POSITION,X(3),Y(3)) TRIANGLE(J,1)=X(1) TRIANGLE(J,2)=X(2) TRIANGLE(J,3)=X(3) TRIANGLE(J,4)=Y(1) TRIANGLE(J,5)=Y(2) TRIANGLE(J,6)=Y(3) X(1)=X(3) Y(1)=Y(3) LETTER=POSITION(1:1) C THIS IF STATEMENT DETERMINES IF THE BOX IS TO HAVE A SOLID BORDER C OR A DASHED ONE. IF TTYPE EQUALS 1, THE TRIANGLR WILL HAVE A SOLID C BORDER, IF TTYPE EQUALS 2, THEN THE TRIANGLE WILL HAVE A DASHED BORDER. IF (LETTER .EQ.'Y') THEN WRITE(6,*)'P[',TRIANGLE(J,1),',',TRIANGLE(J,4),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',TRIANGLE(J,2),',',TRIANGLE(J,5),']' WRITE(6,*)'[',TRIANGLE(J,3),',',TRIANGLE(J,6),']' WRITE(6,*)'[',TRIANGLE(J,1),',',TRIANGLE(J,4),']' TTYPE(J)=2 GOTO 50 ELSE WRITE(6,*)'P[',TRIANGLE(J,1),',',TRIANGLE(J,4),']' WRITE(6,*)'V[',TRIANGLE(J,2),',',TRIANGLE(J,5),']' WRITE(6,*)'[',TRIANGLE(J,3),',',TRIANGLE(J,6),']' WRITE(6,*)'[',TRIANGLE(J,1),',',TRIANGLE(J,4),']' TTYPE(J)=1 END IF IF (LETTER .EQ.'G') THEN GOTO 50 ELSE IF (LETTER .EQ.'B') THEN GOTO 100 ELSE IF (LETTER .EQ.'T') THEN GOTO 500 ELSE IF (LETTER .EQ.'O') THEN GOTO 1000 ELSE IF (LETTER .EQ.'P') THEN GOTO 5000 ELSE IF (LETTER .EQ.'A') THEN GOTO 5100 ELSE IF (LETTER .EQ.'D') THEN GOTO 5200 ELSE IF (LETTER .EQ.'R') THEN GOTO 5300 ELSE IF (LETTER .EQ.'U') THEN GOTO 5400 ELSE IF (LETTER .EQ.'L') THEN GOTO 5500 ELSE IF (LETTER .EQ.'X') THEN GOTO 5550 ELSE IF (LETTER .EQ.'W') THEN GOTO 5600 ELSE IF (LETTER .EQ.'S') THEN GOTO 5699 ELSE IF (LETTER .EQ.'I') THEN GOTO 1 ELSE IF (LETTER .EQ.'E') THEN GOTO 5700 ELSE WRITE(6,95)ESC,'/' PRINT*,'INVALID INPUT' DO 6, TIME=1,10000 6 CONTINUE GOTO 1 END IF C THE FOLLOWING COMMANDS WILL DRAW A CIRCLE AT THE POSITION SPECIFIED. C THE COORDINATES OF EACH CIRCLE WILL BE STORED IN THE CIRCLE ARRAY. 1000 K = K+1 WRITE(6,*)'P[',X(1),',',Y(1),']' WRITE(6,92) READ(5,93)POSITION CALL CONVERT(POSITION,X(2),Y(2)) ARCSIZE=POSITION(1:1) WRITE(6,*)'P[',X(2),',',Y(2),']' WRITE(6,92) READ(5,93)POSITION CALL CONVERT(POSITION,X(3),Y(3)) C THE FOLLOWING WILL DETERMINE: THE RADIUS OF EACH CIRCLE/ARC (RADIUS(K)); C THE TOTAL ANGLE OF EACH CIRCLE/ARC (ANGLE(K)); AND THE STARTING ANGLE C OF EACH CIRCLE/ARC, RELATIVE TO THE HORIZONTAL AXIS OF THE CENTER POINT C (ANGS(K)). IN DETERMINING THE ANGLES, ADJUSTMENTS ARE MADE DUE TO THE C FACT THAT THE ARCCOSINE GIVES ANGLES BETWEEN ONLY 0 AND 180 RATHER THAN, C 0 AND 360. RADIUS(K)=(((X(1)-X(2))**2)+((Y(1)-Y(2))**2))**(.5) C=(((X(2)-X(3))**2)+((Y(2)-Y(3))**2))**(.5) ANGLE(K)=ACOS(((2*(RADIUS(K)**2))-(C**2))/(2*(RADIUS(K)**2))) ANGLE(K)=ANINT((ANGLE(K)*180)/3.14) IF (ANGLE(K) .EQ. 0) ANGLE(K)=360 IF (ARCSIZE.EQ.'H') ANGLE(K)=360-ANGLE(K) IF (ARCSIZE.EQ.'J') ANGLE(K)=360-ANGLE(K) D=((((X(1)+RADIUS(K))-X(2))**2)+((Y(1)-Y(2))**2))**(.5) ANGS(K)=ACOS(((2*(RADIUS(K)**2))-(D**2))/(2*(RADIUS(K)**2))) ANGS(K)=ANINT((ANGS(K)*180)/3.14) IF (ARCSIZE.EQ.'J') ANGS(K)=360-ANGS(K) IF (ARCSIZE.EQ.'K') ANGS(K)=360-ANGS(K) CIRCLE(K,1)=X(1) CIRCLE(K,2)=X(2) CIRCLE(K,3)=X(3) CIRCLE(K,4)=Y(1) CIRCLE(K,5)=Y(2) CIRCLE(K,6)=Y(3) LETTER=POSITION(1:1) C THIS IF STATEMENT DETERMINES IF THE CIRCLE IS TO HAVE A SOLID BORDER C OR A DASHED ONE. IF CTYPE EQUALS 1, THE CIRCLE WILL BE SOLID, IF CTYPE C EQUALS 2, THEN THE CIRCLE WILL BE DASHED. IF (LETTER .EQ. 'Y') THEN CTYPE(K)=2 WRITE(6,*)'P[',CIRCLE(K,1),',',CIRCLE(K,4),']' WRITE(6,*)'P[]C(W(P4(M5)))' WRITE(6,*)'(A',ANGLE(K),')[',CIRCLE(K,2),',',CIRCLE(K,5),']' GOTO 50 ELSE CTYPE(K)=1 WRITE(6,*)'P[',CIRCLE(K,1),',',CIRCLE(K,4),']' WRITE(6,*)'C(A',ANGLE(K),')[',CIRCLE(K,2),',',CIRCLE(K,5),']' END IF IF (LETTER .EQ.'G') THEN GOTO 50 ELSE IF (LETTER .EQ.'B') THEN GOTO 100 ELSE IF (LETTER .EQ.'T') THEN GOTO 500 ELSE IF (LETTER .EQ.'O') THEN GOTO 1000 ELSE IF (LETTER .EQ.'P') THEN GOTO 5000 ELSE IF (LETTER .EQ.'A') THEN GOTO 5100 ELSE IF (LETTER .EQ.'D') THEN GOTO 5200 ELSE IF (LETTER .EQ.'R') THEN GOTO 5300 ELSE IF (LETTER .EQ.'U') THEN GOTO 5400 ELSE IF (LETTER .EQ.'L') THEN GOTO 5500 ELSE IF (LETTER .EQ.'X') THEN GOTO 5550 ELSE IF (LETTER .EQ.'W') THEN GOTO 5600 ELSE IF (LETTER .EQ.'S') THEN GOTO 5699 ELSE IF (LETTER .EQ.'I') THEN GOTO 1 ELSE IF (LETTER .EQ.'E') THEN GOTO 5700 ELSE WRITE(6,95)ESC,'/' PRINT*,'INVALID INPUT' DO 7, TIME=1,10000 7 CONTINUE GOTO 1 END IF C THE FOLLOWING COMMANDS WILL DRAW A POINT AT THE POSITION SPECIFIED. C THE COORDINATES OF THE POINT WILL BE STORED IN THE POINT ARRAY. 5000 M = M+1 POINT(M,1)=X(1) POINT(M,2)=Y(1) WRITE(6,*)'P[',POINT(M,1),',',POINT(M,2),']' WRITE(6,*)'C[+2]' WRITE(6,*)'[+1]' WRITE(6,*)'P[-2]' WRITE(6,*)'C[+1]' GOTO 50 C THE FOLLOWING COMMANDS WILL DRAW A LINE AT THE SPECIFIED LOCATION. C THE COORDINATES WILL BE STORED IN THE LINE ARRAY. 5100 L = L+1 WRITE(6,*)'P[',X(1),',',Y(1),']' WRITE(6,92) READ(5,93)POSITION CALL CONVERT(POSITION,X(2),Y(2)) LINE(L,1)=X(1) LINE(L,2)=X(2) LINE(L,3)=Y(1) LINE(L,4)=Y(2) X(1)=X(2) Y(1)=Y(2) LETTER=POSITION(1:1) C THIS IF STATEMENT WILL DETERMINE IF THE LINE IS TO BE SOLID OR DASHED. C IF LTYPE EQUALS 1, THEN THE LINE WILL BE SOLID. IF LTYPE EQUALS 2, THEN C THE LINE WILL BE DASHED. IF (LETTER .EQ.'Y') THEN WRITE(6,*)'P[',LINE(L,1),',',LINE(L,3),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',LINE(L,2),',',LINE(L,4),']' LTYPE(L)=2 GOTO 50 ELSE WRITE(6,*)'P[',LINE(L,1),',',LINE(L,3),']' WRITE(6,*)'V[',LINE(L,2),',',LINE(L,4),']' LTYPE(L)=1 END IF IF (LETTER .EQ.'G') THEN GOTO 50 ELSE IF (LETTER .EQ.'B') THEN GOTO 100 ELSE IF (LETTER .EQ.'T') THEN GOTO 500 ELSE IF (LETTER .EQ.'O') THEN GOTO 1000 ELSE IF (LETTER .EQ.'P') THEN GOTO 5000 ELSE IF (LETTER .EQ.'A') THEN GOTO 5100 ELSE IF (LETTER .EQ.'D') THEN GOTO 5200 ELSE IF (LETTER .EQ.'R') THEN GOTO 5300 ELSE IF (LETTER .EQ.'U') THEN GOTO 5400 ELSE IF (LETTER .EQ.'L') THEN GOTO 5500 ELSE IF (LETTER .EQ.'X') THEN GOTO 5550 ELSE IF (LETTER .EQ.'W') THEN GOTO 5600 ELSE IF (LETTER .EQ.'S') THEN GOTO 5699 ELSE IF (LETTER .EQ.'I') THEN GOTO 1 ELSE IF (LETTER .EQ.'E') THEN GOTO 5700 ELSE WRITE(6,95)ESC,'/' PRINT*,'INVALID INPUT' DO 8, TIME=1,10000 8 CONTINUE GOTO 1 END IF C THE FOLLOWING COMMANDS WILL DRAW AN ARROWHEAD IN THE POSITION SPECIFIED. C THE COORDINATES OF EACH DOWNWARD FACING ARROW WILL BE STORED IN THE C ADOWN ARRAY. 5200 ND = ND+1 ADOWN(ND,1)=X(1) ADOWN(ND,2)=Y(1) WRITE(6,*)'P[',ADOWN(ND,1),',',ADOWN(ND,2),']' WRITE(6,*)'V[-5,-5]' WRITE(6,*)'P[',ADOWN(ND,1),',',ADOWN(ND,2),']' WRITE(6,*)'V[+5,-5]' GOTO 50 C THE FOLLOWING COMMANDS WILL DRAW AN ARROWHEAD IN THE POSITION SPECIFIED. C THE COORDINATES OF EACH ARROW FACING TO THE RIGHT WILL BE STORED IN THE C ARIGHT ARRAY. 5300 NR = NR+1 ARIGHT(NR,1)=X(1) ARIGHT(NR,2)=Y(1) WRITE(6,*)'P[',ARIGHT(NR,1),',',ARIGHT(NR,2),']' WRITE(6,*)'V[-5,-5]' WRITE(6,*)'P[',ARIGHT(NR,1),',',ARIGHT(NR,2),']' WRITE(6,*)'V[-5,+5]' GOTO 50 C THE FOLLOWING COMMANDS WILL DRAW AN ARROWHEAD IN THE POSITION SPECIFIED. C THE COORDINATES OF EACH UPWARD FACING ARROW WILL BE STORED IN THE C AUP ARRAY. 5400 NU = NU+1 AUP(NU,1)=X(1) AUP(NU,2)=Y(1) WRITE(6,*)'P[',AUP(NU,1),',',AUP(NU,2),']' WRITE(6,*)'V[-5,+5]' WRITE(6,*)'P[',AUP(NU,1),',',AUP(NU,2),']' WRITE(6,*)'V[+5,+5]' GOTO 50 C THE FOLLOWING COMMANDS WILL DRAW AN ARROWHEAD IN THE POSITION SPECIFIED. C THE COORDINATES OF EACH LEFT FACING ARROW WILL BE STORED IN THE ALEFT C ARRAY. 5500 NL = NL+1 ALEFT(NL,1)=X(1) ALEFT(NL,2)=Y(1) WRITE(6,*)'P[',ALEFT(NL,1),',',ALEFT(NL,2),']' WRITE(6,*)'V[+5,-5]' WRITE(6,*)'P[',ALEFT(NL,1),',',ALEFT(NL,2),']' WRITE(6,*)'V[+5,+5]' GOTO 50 C THE FOLLOWING COMMANDS WILL ERASE THE OBJECT SPECIFIED. C FOR EACH OBJECT, THE SPECIFIED ARRAY WILL BE SEARCHED TO FIND THE C PLACE IN THE ARRAY WHERE THE OBJECT IS STORED. THE SEARCH WILL BE C DONE BY COMPARING THE COORDINATES OF THE OBJECT TO BE ERASED WITH C THE COORDINATES OF THE OBJECTS STORED IN THAT ARRAY. THE OBJECT WILL C BE TAKEN OUT OF THE ARRAY BY MOVING EACH OBJECT, FROM THAT OBJECT ON, C UP ONE SLOT IN THE ARRAY. ANY OTHER NECESSARY CHANGES ABOUT THE OBJECT C WILL ALSO BE MADE IN A SIMILAR MANNER. THE OBJECT AS SEEN ON THE SCREEN C WILL BE ERASED BY WRITING OVER THAT OBJECT IN THE SCREEN BACKGROUND C COLOR. 5550 WRITE(6,*)'P[',X(1),',',Y(1),']' WRITE(6,92) READ(5,93)POSITION LETTER=POSITION(1:1) CALL CONVERT(POSITION,X(2),Y(2)) IF (LETTER .NE. 'B') GOTO 5557 DO 5555, TEMP=1,ICOUNT IF(((BOX(TEMP,1).EQ.X(1)).OR.(BOX(TEMP,2).EQ.X(1))).AND. $ ((BOX(TEMP,1).EQ.X(2)).OR.(BOX(TEMP,2).EQ.X(2))).AND. $ ((BOX(TEMP,3).EQ.Y(1)).OR.((BOX(TEMP,3)+1).EQ.Y(1)).OR. $ ((BOX(TEMP,3)-1).EQ.Y(1)).OR.(BOX(TEMP,4).EQ.Y(1)).OR. $ ((BOX(TEMP,4)+1).EQ.Y(1)).OR.((BOX(TEMP,4)-1).EQ.Y(1))).AND. $ ((BOX(TEMP,3).EQ.Y(2)).OR.((BOX(TEMP,3)+1).EQ.Y(2)).OR. $ ((BOX(TEMP,3)-1).EQ.Y(2)).OR.(BOX(TEMP,4).EQ.Y(2)).OR. $ ((BOX(TEMP,4)+1).EQ.Y(2)).OR.((BOX(TEMP,4)-1).EQ.Y(2)))) THEN IF (BTYPE(TEMP) .EQ. 2) THEN WRITE(6,*)'W(E)P[',BOX(TEMP,1),',',BOX(TEMP,3),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',BOX(TEMP,2),']' WRITE(6,*)'[,',BOX(TEMP,4),']' WRITE(6,*)'[',BOX(TEMP,1),']' WRITE(6,*)'[,',BOX(TEMP,3),']' WRITE(6,*)'W(V)' ELSE WRITE(6,*)'W(E)P[',BOX(TEMP,1),',',BOX(TEMP,3),']' WRITE(6,*)'V[',BOX(TEMP,2),']' WRITE(6,*)'[,',BOX(TEMP,4),']' WRITE(6,*)'[',BOX(TEMP,1),']' WRITE(6,*)'[,',BOX(TEMP,3),']' WRITE(6,*)'W(V)' END IF IF (TEMP.EQ. ICOUNT) THEN ICOUNT=ICOUNT-1 ELSE DO 5554,TEMPNEW=TEMP,ICOUNT-1 BOX(TEMPNEW,1)=BOX((TEMPNEW+1),1) BOX(TEMPNEW,2)=BOX((TEMPNEW+1),2) BOX(TEMPNEW,3)=BOX((TEMPNEW+1),3) BOX(TEMPNEW,4)=BOX((TEMPNEW+1),4) BTYPE(TEMPNEW)=BTYPE(TEMPNEW+1) 5554 CONTINUE ICOUNT=ICOUNT-1 ENDIF ENDIF 5555 CONTINUE 5557 IF(LETTER .NE.'T') GOTO 5563 WRITE(6,*)'P[',X(2),',',Y(2),']' WRITE(6,92) READ(5,93)POSITION CALL CONVERT(POSITION,X(3),Y(3)) DO 5561, TEMP=1,J IF(((TRIANGLE(TEMP,1).EQ.X(1)).OR.(TRIANGLE(TEMP,2).EQ.X(1)).OR. $ (TRIANGLE(TEMP,3).EQ.X(1))).AND. $ ((TRIANGLE(TEMP,1).EQ.X(2)).OR.(TRIANGLE(TEMP,2).EQ.X(2)).OR. $ (TRIANGLE(TEMP,3).EQ.X(2))).AND. $ ((TRIANGLE(TEMP,1).EQ.X(3)).OR.(TRIANGLE(TEMP,2).EQ.X(3)).OR. $ (TRIANGLE(TEMP,3).EQ.X(3))).AND. $ ((TRIANGLE(TEMP,4).EQ.Y(1)).OR.((TRIANGLE(TEMP,4)+1).EQ.Y(1)).OR. $ ((TRIANGLE(TEMP,4)-1).EQ.Y(1)).OR.(TRIANGLE(TEMP,5).EQ.Y(1)).OR. $ ((TRIANGLE(TEMP,5)+1).EQ.Y(1)).OR.((TRIANGLE(TEMP,5)-1).EQ.Y(1)) $ .OR. $ (TRIANGLE(TEMP,6).EQ.Y(1)).OR.((TRIANGLE(TEMP,6)+1).EQ.Y(1)).OR. $ ((TRIANGLE(TEMP,6)-1).EQ.Y(1))).AND. $ ((TRIANGLE(TEMP,4).EQ.Y(2)).OR.((TRIANGLE(TEMP,4)+1).EQ.Y(2)).OR. $ ((TRIANGLE(TEMP,4)-1).EQ.Y(2)).OR.(TRIANGLE(TEMP,5).EQ.Y(2)).OR. $ ((TRIANGLE(TEMP,5)+1).EQ.Y(2)).OR.((TRIANGLE(TEMP,5)-1).EQ.Y(2)) $ .OR. $ (TRIANGLE(TEMP,6).EQ.Y(2)).OR.((TRIANGLE(TEMP,6)+1).EQ.Y(2)).OR. $ ((TRIANGLE(TEMP,6)-1).EQ.Y(2))).AND. $ ((TRIANGLE(TEMP,4).EQ.Y(3)).OR.((TRIANGLE(TEMP,4)+1).EQ.Y(3)).OR. $ ((TRIANGLE(TEMP,4)-1).EQ.Y(3)).OR.(TRIANGLE(TEMP,5).EQ.Y(3)).OR. $ ((TRIANGLE(TEMP,5)+1).EQ.Y(3)).OR.((TRIANGLE(TEMP,5)-1).EQ.Y(3)) $ .OR. $ (TRIANGLE(TEMP,6).EQ.Y(3)).OR.((TRIANGLE(TEMP,6)+1).EQ.Y(3)).OR. $ ((TRIANGLE(TEMP,6)-1).EQ.Y(3)))) THEN IF (TTYPE(TEMP) .EQ. 2) THEN WRITE(6,*)'W(E)' WRITE(6,*)'P[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),']' WRITE(6,*)'[',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),']' WRITE(6,*)'[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(6,*)'W(V)' ELSE WRITE(6,*)'W(E)' WRITE(6,*)'P[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(6,*)'V[',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),']' WRITE(6,*)'[',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),']' WRITE(6,*)'[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(6,*)'W(V)' END IF IF (TEMP.EQ.J) THEN J=J-1 ELSE DO 5560, TEMPNEW=TEMP,J-1 TRIANGLE(TEMPNEW,1)=TRIANGLE((TEMPNEW+1),1) TRIANGLE(TEMPNEW,2)=TRIANGLE((TEMPNEW+1),2) TRIANGLE(TEMPNEW,3)=TRIANGLE((TEMPNEW+1),3) TRIANGLE(TEMPNEW,4)=TRIANGLE((TEMPNEW+1),4) TRIANGLE(TEMPNEW,5)=TRIANGLE((TEMPNEW+1),5) TRIANGLE(TEMPNEW,6)=TRIANGLE((TEMPNEW+1),6) TTYPE(TEMPNEW)=TTYPE(TEMPNEW+1) 5560 CONTINUE J=J-1 END IF END IF 5561 CONTINUE 5563 IF(LETTER .NE. 'O') GOTO 5567 DO 5565,TEMP=1,K R=(((X(1)-X(2))**2)+((Y(1)-Y(2))**2))**(.5) IF(((CIRCLE(TEMP,1).EQ.X(1)).OR.((CIRCLE(TEMP,1)+1).EQ.X(1)).OR. $ ((CIRCLE(TEMP,1)-1).EQ.X(1))).AND. $ ((RADIUS(TEMP).EQ.R).OR.((RADIUS(TEMP)+1).EQ.R).OR. $ ((RADIUS(TEMP)-1).EQ.R)).AND. $ ((CIRCLE(TEMP,4).EQ.Y(1)).OR.((CIRCLE(TEMP,4)+1).EQ.Y(1)).OR. $ ((CIRCLE(TEMP,4)-1).EQ.Y(1)))) THEN WRITE(6,*)'W(E)' IF (CTYPE(TEMP) .EQ. 2) THEN WRITE(6,*)'P[',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),']' WRITE(6,*)'P[]C(W(P4(M5)))' WRITE(6,*)'(A',ANGLE(TEMP),')[',CIRCLE(TEMP,2),',', $ CIRCLE(TEMP,5),']' ELSE WRITE(6,*)'P[',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),']' WRITE(6,*)'C(A',ANGLE(TEMP),')[',CIRCLE(TEMP,2),',', $ CIRCLE(TEMP,5),']' END IF WRITE(6,*)'W(V)' IF (TEMP.EQ. K) THEN K=K-1 ELSE DO 5564,TEMPNEW=TEMP,K-1 CIRCLE(TEMPNEW,1)=CIRCLE((TEMPNEW+1),1) CIRCLE(TEMPNEW,2)=CIRCLE((TEMPNEW+1),2) CIRCLE(TEMPNEW,3)=CIRCLE((TEMPNEW+1),3) CIRCLE(TEMPNEW,4)=CIRCLE((TEMPNEW+1),4) CIRCLE(TEMPNEW,5)=CIRCLE((TEMPNEW+1),5) CIRCLE(TEMPNEW,6)=CIRCLE((TEMPNEW+1),6) CTYPE(TEMPNEW)=CTYPE(TEMPNEW+1) ANGLE(TEMPNEW)=ANGLE(TEMPNEW+1) RADIUS(TEMPNEW)=RADIUS(TEMPNEW+1) ANGS(TEMP)=ANGS(TEMP+1) 5564 CONTINUE K=K-1 END IF ENDIF 5565 CONTINUE 5567 IF(LETTER.NE. 'P') GOTO 5571 DO 5569,TEMP=1,M IF(((POINT(TEMP,1).EQ.X(1)).OR.((POINT(TEMP,1)+1).EQ.X(1)).OR. $ ((POINT(TEMP,1)-1).EQ.X(1))) $ .AND.((POINT(TEMP,2).EQ.Y(1)).OR.((POINT(TEMP,2)+1).EQ.Y(1)).OR. $ ((POINT(TEMP,2)-1).EQ.Y(1)))) THEN WRITE(6,*)'W(E)P[',POINT(TEMP,1),',',POINT(TEMP,2),']' WRITE(6,*)'C[+2]' WRITE(6,*)'[+1]' WRITE(6,*)'P[-2]' WRITE(6,*)'C[+1]' WRITE(6,*)'W(V)' IF(TEMP.EQ.M) THEN M=M-1 ELSE DO 5568,TEMPNEW=TEMP,M-1 POINT(TEMPNEW,1)=POINT((TEMPNEW+1),1) POINT(TEMPNEW,2)=POINT((TEMPNEW+1),2) 5568 CONTINUE M=M-1 END IF END IF 5569 CONTINUE 5571 IF(LETTER .NE. 'A') GOTO 5575 DO 5573, TEMP=1,L IF(((LINE(TEMP,1).EQ.X(1)).OR.(LINE(TEMP,2).EQ.X(1))).AND. $ ((LINE(TEMP,1).EQ.X(2)).OR.(LINE(TEMP,2).EQ.X(2))).AND. $ ((LINE(TEMP,3).EQ.Y(1)).OR.((LINE(TEMP,3)+1).EQ.Y(1)).OR. $ ((LINE(TEMP,3)-1).EQ.Y(1)).OR.(LINE(TEMP,4).EQ.Y(1)).OR. $ ((LINE(TEMP,4)+1).EQ.Y(1)).OR.((LINE(TEMP,4)-1).EQ.Y(1))).AND. $ ((LINE(TEMP,3).EQ.Y(2)).OR.((LINE(TEMP,3)+1).EQ.Y(2)).OR. $ ((LINE(TEMP,3)-1).EQ.Y(2)).OR.(LINE(TEMP,4).EQ.Y(2)).OR. $ ((LINE(TEMP,4)+1).EQ.Y(2)).OR.((LINE(TEMP,4)-1).EQ.Y(2)))) THEN WRITE(6,*)'W(E)P[',LINE(TEMP,1),',',LINE(TEMP,3),']' IF (LTYPE(TEMP) .EQ.2) THEN WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',LINE(TEMP,2),',',LINE(TEMP,4),']' ELSE WRITE(6,*)'V[',LINE(TEMP,2),',',LINE(TEMP,4),']' END IF WRITE(6,*)'W(V)' IF(TEMP.EQ.L) THEN L=L-1 ELSE DO 5572,TEMPNEW=TEMP,L-1 LINE(TEMPNEW,1)=LINE((TEMPNEW+1),1) LINE(TEMPNEW,2)=LINE((TEMPNEW+1),2) LINE(TEMPNEW,3)=LINE((TEMPNEW+1),3) LINE(TEMPNEW,4)=LINE((TEMPNEW+1),4) LTYPE(TEMPNEW)=LTYPE(TEMPNEW+1) 5572 CONTINUE L=L-1 END IF END IF 5573 CONTINUE 5575 IF(LETTER .NE. 'D') GOTO 5579 DO 5577,TEMP=1,ND IF(((ADOWN(TEMP,1).EQ.X(1)).OR.((ADOWN(TEMP,1)+1).EQ.X(1)).OR. $ ((ADOWN(TEMP,1)-1).EQ.X(1))) $ .AND.((ADOWN(TEMP,2).EQ.Y(1)).OR.((ADOWN(TEMP,2)+1).EQ.Y(1)).OR. $ ((ADOWN(TEMP,2)-1).EQ.Y(1)))) THEN WRITE(6,*)'W(E)' WRITE(6,*)'P[',ADOWN(TEMP,1),',',ADOWN(TEMP,2),']' WRITE(6,*)'V[-5,-5]' WRITE(6,*)'P[',ADOWN(TEMP,1),',',ADOWN(TEMP,2),']' WRITE(6,*)'V[+5,-5]' WRITE(6,*)'W(V)' IF(TEMP.EQ.ND) THEN ND=ND-1 ELSE DO 5576, TEMPNEW=TEMP,ND-1 ADOWN(TEMPNEW,1)=ADOWN((TEMPNEW+1),1) ADOWN(TEMPNEW,2)=ADOWN((TEMPNEW+1),2) 5576 CONTINUE ND=ND-1 END IF END IF 5577 CONTINUE 5579 IF (LETTER .NE. 'R') GOTO 5583 DO 5581,TEMP=1,NR IF(((ARIGHT(TEMP,1).EQ.X(1)).OR.((ARIGHT(TEMP,1)+1).EQ.X(1)).OR. $ ((ARIGHT(TEMP,1)-1).EQ.X(1))) $ .AND.((ARIGHT(TEMP,2).EQ.Y(1)).OR.((ARIGHT(TEMP,2)+1).EQ.Y(1)) $ .OR.((ARIGHT(TEMP,2)-1).EQ.Y(1)))) THEN WRITE(6,*)'W(E)' WRITE(6,*)'P[',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),']' WRITE(6,*)'V[-5,-5]' WRITE(6,*)'P[',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),']' WRITE(6,*)'V[-5,+5]' WRITE(6,*)'W(V)' IF (TEMP.EQ.NR) THEN NR=NR-1 ELSE DO 5580, TEMPNEW=TEMP,NR-1 ARIGHT(TEMPNEW,1)=ARIGHT((TEMPNEW+1),1) ARIGHT(TEMPNEW,2)=ARIGHT((TEMPNEW+1),2) 5580 CONTINUE NR=NR-1 END IF END IF 5581 CONTINUE 5583 IF (LETTER .NE. 'U') GOTO 5587 DO 5585,TEMP=1,NU IF(((AUP(TEMP,1).EQ.X(1)).OR.((AUP(TEMP,1)+1).EQ.X(1)).OR. $ ((AUP(TEMP,1)-1).EQ.X(1))) $ .AND.((AUP(TEMP,2).EQ.Y(1)).OR.((AUP(TEMP,2)+1).EQ.Y(1)).OR. $ ((AUP(TEMP,2)-1).EQ.Y(1)))) THEN WRITE(6,*)'W(E)' WRITE(6,*)'P[',AUP(TEMP,1),',',AUP(TEMP,2),']' WRITE(6,*)'V[-5,+5]' WRITE(6,*)'P[',AUP(TEMP,1),',',AUP(TEMP,2),']' WRITE(6,*)'V[+5,+5]' WRITE(6,*)'W(V)' IF(TEMP.EQ.NU) THEN NU=NU-1 ELSE DO 5584, TEMPNEW=TEMP,NU-1 AUP(TEMPNEW,1)=AUP((TEMPNEW+1),1) AUP(TEMPNEW,2)=AUP((TEMPNEW+1),2) 5584 CONTINUE NU=NU-1 END IF END IF 5585 CONTINUE 5587 IF(LETTER .NE. 'L') GOTO 5591 DO 5589,TEMP=1,NL IF(((ALEFT(TEMP,1).EQ.X(1)).OR.((ALEFT(TEMP,1)+1).EQ.X(1)).OR. $ ((ALEFT(TEMP,1)-1).EQ.X(1))) $ .AND.((ALEFT(TEMP,2).EQ.Y(1)).OR.((ALEFT(TEMP,2)+1).EQ.Y(1)).OR. $ ((ALEFT(TEMP,2)-1).EQ.Y(1)))) THEN WRITE(6,*)'W(E)' WRITE(6,*)'P[',ALEFT(TEMP,1),',',ALEFT(TEMP,2),']' WRITE(6,*)'V[+5,-5]' WRITE(6,*)'P[',ALEFT(TEMP,1),',',ALEFT(TEMP,2),']' WRITE(6,*)'V[+5,+5]' WRITE(6,*)'W(V)' IF(TEMP.EQ.NL) THEN NL=NL-1 ELSE DO 5588, TEMPNEW=TEMP,NL-1 ALEFT(TEMPNEW,1)=ALEFT((TEMPNEW+1),1) ALEFT(TEMPNEW,2)=ALEFT((TEMPNEW+1),2) 5588 CONTINUE NL=NL-1 END IF END IF 5589 CONTINUE 5591 IF(LETTER .NE. 'W') GOTO 5599 TEMP=0 5595 TEMP=TEMP+1 IF(((TEXT(TEMP,1).EQ.X(1)).OR.((TEXT(TEMP,1)+1).EQ.X(1)).OR. $ ((TEXT(TEMP,1)-1).EQ.X(1))) $ .AND.((TEXT(TEMP,2).EQ.Y(1)).OR.((TEXT(TEMP,2)+1).EQ.Y(1)).OR. $ ((TEXT(TEMP,2)-1).EQ.Y(1)))) THEN SS=0 SM=2 SL=4 WRITE(6,*)'W(E)P[',TEXT(TEMP,1),',',TEXT(TEMP,2),']' DO 113,NW=START(TEMP),FINISH(TEMP) TEMPC=QUOTE(NW) QM=INDEX(TEMPC,'''') IF (QM .EQ. 0) THEN LAST=80 114 IF((TEMPC(LAST:LAST).EQ.' ').AND. $ (LAST.NE.1)) THEN LAST=LAST-1 GOTO 114 ELSE TEMPC(LAST+1:LAST+1)='''' QUOTE(NW)=TEMPC(1:LAST+1) END IF IF (TYPE(TEMP).EQ.1) THEN WRITE(6,*)'T(S0,H1)''',QUOTE(NW) SS=SS+10 WRITE(6,*)'P[',TEXT(TEMP,1),',',(TEXT(TEMP,2)+SS),']' ELSE IF (TYPE(TEMP).EQ.2) THEN WRITE(6,*)'T(S0,H0)''',QUOTE(NW) SM=SM+20 WRITE(6,*)'P[',TEXT(TEMP,1),',',(TEXT(TEMP,2)+SM),']' ELSE IF (TYPE(TEMP).EQ.3) THEN WRITE(6,*)'T(S2,H3)''',QUOTE(NW) SL=SL+30 WRITE(6,*)'P[',TEXT(TEMP,1),',',(TEXT(TEMP,2)+SL),']' END IF ELSE IF (TYPE(TEMP).EQ.1) THEN WRITE(6,*)'T(S0,H1)''',QUOTE(NW) SS=SS+10 WRITE(6,*)'P[',TEXT(TEMP,1),',',(TEXT(TEMP,2)+SS),']' ELSE IF (TYPE(TEMP).EQ.2) THEN WRITE(6,*)'T(S0,H0)''',QUOTE(NW) SM=SM+20 WRITE(6,*)'P[',TEXT(TEMP,1),',',(TEXT(TEMP,2)+SM),']' ELSE IF (TYPE(TEMP).EQ.3) THEN WRITE(6,*)'T(S2,H3)''',QUOTE(NW) SL=SL+30 WRITE(6,*)'P[',TEXT(TEMP,1),',',(TEXT(TEMP,2)+SL),']' END IF END IF 113 CONTINUE WRITE(6,*)'W(V)' IF(TEMP.EQ.Q) THEN FINAL=FINISH(Q-1) ELSE VALUE=FINISH(TEMP) DIF=FINISH(TEMP)-START(TEMP)+1 FINAL=FINISH(Q)-DIF DO 5593,N=START(TEMP),FINAL VALUE=VALUE+1 QUOTE(N)=QUOTE(VALUE) 5593 CONTINUE DO 5594, TEMPNEW=TEMP,Q-1 TEXT(TEMPNEW,1)=TEXT((TEMPNEW+1),1) TEXT(TEMPNEW,2)=TEXT((TEMPNEW+1),2) TYPE(TEMPNEW)=TYPE(TEMPNEW+1) START(TEMPNEW)=START(TEMPNEW+1)-DIF FINISH(TEMPNEW)=FINISH(TEMPNEW+1)-DIF 5594 CONTINUE END IF Q=Q-1 LINENUM=FINAL ELSE IF (TEMP.LT.Q) THEN GOTO 5595 END IF 5599 GOTO 50 C THE FOLLOWING WILL WRITE TEXT ON THE DIAGRAM. THE STARTING POSITION C COORDINATES OF EACH INDIVIDUAL QUOTE WILL BE STORED IN THE 'TEXT' ARRAY. C (THAT IS, EACH TIME THE TEXT PORTION OF THIS PROGRAM IS ENTERED, THE C COORDINATES WILL BE STORED.) A RUNNING TALLY OF THE TOTAL NUMBER OF C QUOTES IN THE WHOLE DIAGRAM WILL BE STORED UNDER 'LINENUM', AS WELL AS C TWO ARRAYS, 'START' AND 'FINISH', WHICH WILL STORE THE BEGINNING AND C ENDING LINE NUMBER OF EACH INDIVIDUAL QUOTE. THE PRINT SIZE WILL BE C STORED IN THE ARRAY 'TYPE'. EACH LINE OF TEXT WILL BE STORED IN THE C 'QUOTE' ARRAY. 5600 Q=Q+1 START(Q)=LINENUM+1 TEXT(Q,1)=X(1) TEXT(Q,2)=Y(1) WRITE(6,*)'P[',X(1),',',Y(1),']' WRITE(6,92) READ(5,93) POSITION LETTER=POSITION(1:1) IF(LETTER .EQ. '1') GOTO 5610 IF(LETTER .EQ. '2') GOTO 5620 IF(LETTER .EQ. '3') GOTO 5630 5610 TYPE(Q)=1 WRITE(6,*)'T(S0,H1)''' GOTO 5640 5620 TYPE(Q)=2 WRITE(6,*)'T(S0,H0)''' GOTO 5640 5630 TYPE(Q)=3 WRITE(6,*)'T(S2,H3)''' 5640 LINENUM=LINENUM+1 READ(5,5642)QUOTE(LINENUM) 5642 FORMAT(A80) IF(INDEX(QUOTE(LINENUM),'''').EQ.0) THEN GOTO 5640 ELSE FINISH(Q)=LINENUM GOTO 50 END IF C THE FOLLOWING WILL SCROLL THE SCREEN TO THE POSITION SPECIFIED. C THIS PROGRAM ALLOWS THE USER UP TO FOUR SCREENS FOR EACH DIAGRAM. C EACH SCREEN IS 1/4 OF THE WHOLE PAGE OF B-SIZE PAPER. EACH SCREEN C IS 800 BY 480 PIXELS GIVING A TOTAL GRAPHICS AREA OF 1600 BY 960. C IF A-SIZE PAPER IS SPECIFIED (WHICH IS GOING TO BE PLACED HORIZONTALLY C ON THE PLOTTER) THEN, THE TOTAL GRAPHICS AREA IS REDUCED TO 1000 BY 720. C IF A-SIZE PAPER IS SPECIFIED (WHICH IS GOING TO BE PLACED VERTICALLY C ON THE PLOTTER) THEN, THE TOTAL GRAPHICS AREA IS REDUCED TO 800 BY 960. 5699 WRITE(6,95)ESC,'\' IF (SIZE .EQ. 'VA') THEN PRINT*,'DO YOU WANT TO SCROLL UP, DOWN OR REDRAW?' ELSE PRINT*,'DO YOU WANT TO SCROLL UP,DOWN,RIGHT,LEFT OR REDRAW?' END IF READ(5,5698)RESULT 5698 FORMAT(A6) IF (RESULT .EQ. 'DOWN') THEN S=1 Y1=Y1+240 Y2=Y2+240 IF (Y2.GT.960) THEN Y1=480 Y2=959 PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 END IF IF ((SIZE .EQ. 'HA') .AND. (Y2.GT.720)) THEN Y1=240 Y2=719 PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 END IF ELSE IF (RESULT .EQ. 'UP') THEN S=1 Y1=Y1-240 Y2=Y2-240 IF (Y1.LT.O) THEN Y1=0 Y2=479 PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 END IF ELSE IF (RESULT .EQ.'RIGHT') THEN S=1 IF (SIZE .EQ. 'VA') THEN PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 ELSE IF (SIZE .EQ. 'HA') THEN X1=X1+200 X2=X2+200 IF (X2 .GT. 1000) THEN X1=200 X2=1000 PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 END IF ELSE IF (SIZE .EQ. 'B') THEN X1=X1+400 X2=X2+400 IF (X2.GT.1600) THEN X1=800 X2=1599 PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 END IF END IF ELSE IF (RESULT .EQ. 'LEFT') THEN S=1 IF (SIZE .EQ. 'VA') THEN PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 ELSE IF (SIZE .EQ. 'HA') THEN X1=X1-200 X2=X2-200 ELSE IF (SIZE .EQ. 'B') THEN X1=X1-400 X2=X2-400 END IF IF (X1.LT.0) THEN X1=0 X2=799 PRINT*,'OUT OF DRAWING RANGE' GOTO 5699 END IF ELSE IF (RESULT .EQ. 'REDRAW') THEN GOTO 5697 END IF WRITE(6,90) CSI,'2J' WRITE(6,91) ESC,'Pp' WRITE(6,*)'S(A[',X1,',',Y1,'][',X2,',',Y2,'])' WRITE(6,95) ESC,'\' 5697 CALL SETUP(ICOUNT,J,K,L,M,ND,NR,NU,NL,BOX,TRIANGLE,CIRCLE,POINT, $ LINE,ADOWN,ARIGHT,AUP,ALEFT,S,TEXT,Q,START,FINISH,TYPE,QUOTE, $ LTYPE,CTYPE,ANGLE,BTYPE,TTYPE) GOTO 50 C C THE FOLLOWING COMMANDS STORE ALL THE DIFFERENT OBJECT ARRAYS THAT MAKE C UP THE DIAGRAM. C 5700 WRITE(9,*)ICOUNT,J,K,L,M,ND,NR,NU,NL,Q,LINENUM WRITE(9,*)((BOX(TEMPX,TEMPY), TEMPY=1,4), TEMPX=1,ICOUNT) WRITE(9,*)((TRIANGLE(TEMPX,TEMPY), TEMPY=1,6), TEMPX=1,J) WRITE(9,*)((CIRCLE(TEMPX,TEMPY), TEMPY=1,6), TEMPX=1,K) WRITE(9,*)((POINT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,M) WRITE(9,*)((LINE(TEMPX,TEMPY), TEMPY=1,4), TEMPX=1,L) WRITE(9,*)((ADOWN(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,ND) WRITE(9,*)((ARIGHT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,NR) WRITE(9,*)((AUP(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,NU) WRITE(9,*)((ALEFT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,NL) WRITE(9,*)((TEXT(TEMPX,TEMPY), TEMPY=1,2), TEMPX=1,Q) WRITE(9,*)(TYPE(TEMP), TEMP=1,Q) WRITE(9,13)(QUOTE(TEMP), TEMP=1,LINENUM) WRITE(9,*)(START(TEMP), TEMP=1,Q) WRITE(9,*)(FINISH(TEMP), TEMP=1,Q) WRITE(9,*)(LTYPE(TEMP), TEMP=1,L) WRITE(9,*)(CTYPE(TEMP), TEMP=1,K) WRITE(9,*)(ANGLE(TEMP), TEMP=1,K) WRITE(9,*)(RADIUS(TEMP), TEMP=1,K) WRITE(9,*)(ANGS(TEMP), TEMP=1,K) WRITE(9,*)(BTYPE(TEMP), TEMP=1,ICOUNT) WRITE(9,*)(TTYPE(TEMP), TEMP=1,J) 13 FORMAT(X,A60) C C THE FOLLOWING COMMANDS WRITE TO TWO DIFFERENT TEXT FILES C ONE STORES THE INFORMATION SO THE DIAGRAM CAN BE DRAWN C ON THE SCREEN. (WRITE(4,*)) C THE OTHER STORES THE INFORMATION SO THE DIAGRAM CAN BE DRAWN C ON THE PLOTTER. (WRITE(7,*)) C WRITE(4,90) CSI,'2J' WRITE(7,*)' CALL PLOTS(1,5,6)' WRITE(7,*)' CALL SETIN' IF (SIZE .EQ. 'HA') THEN WRITE(7,*)' CALL LOCATE (0.0,9.45,0.0,7.325)' WRITE(7,*)' CALL MAPUU(0.0,1000.0,720.0,0.0)' ELSE WRITE(7,*)' CALL LOCATE (0.0,14.95,0.0,9.825)' WRITE(7,*)' CALL MAPUU(0.0,1600.0,960.0,0.0)' END IF WRITE(7,*)' CALL PENSPD(10)' WRITE(4,91) ESC,'Pp' IF (ICOUNT .EQ. 0) GOTO 5710 DO 5705, TEMP=1,ICOUNT IF (BTYPE(TEMP) .EQ. 2) THEN WRITE(4,*)'P[',BOX(TEMP,1),',',BOX(TEMP,3),']' WRITE(4,*)'P[]V(W(P4(M5)))' WRITE(4,*)'[',BOX(TEMP,2),']' WRITE(4,*)'[,',BOX(TEMP,4),']' WRITE(4,*)'[',BOX(TEMP,1),']' WRITE(4,*)'[,',BOX(TEMP,3),']' ELSE WRITE(4,*)'P[',BOX(TEMP,1),',',BOX(TEMP,3),']' WRITE(4,*)'V[',BOX(TEMP,2),']' WRITE(4,*)'[,',BOX(TEMP,4),']' WRITE(4,*)'[',BOX(TEMP,1),']' WRITE(4,*)'[,',BOX(TEMP,3),']' END IF 5705 CONTINUE DO 5707, TEMP=1,ICOUNT IF (BTYPE(TEMP) .EQ. 2) THEN WRITE(7,990)'CALL DASLNA(3,20)' WRITE(7,999)'CALL MOVE(',BOX(TEMP,1),',',BOX(TEMP,3),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,2),',',BOX(TEMP,3),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,2),',',BOX(TEMP,4),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,1),',',BOX(TEMP,4),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,1),',',BOX(TEMP,3),')' WRITE(7,990)'CALL DASLNA(1,20)' ELSE WRITE(7,999)'CALL MOVE(',BOX(TEMP,1),',',BOX(TEMP,3),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,2),',',BOX(TEMP,3),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,2),',',BOX(TEMP,4),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,1),',',BOX(TEMP,4),')' WRITE(7,999)'CALL DRAW(',BOX(TEMP,1),',',BOX(TEMP,3),')' END IF 5707 CONTINUE 5710 IF (J .EQ. 0) GOTO 5720 DO 5715, TEMP=1,J IF (TTYPE(TEMP) .EQ. 2) THEN WRITE(4,*)'P[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(4,*)'P[]V(W(P4(M5)))' WRITE(4,*)'[',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),']' WRITE(4,*)'[',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),']' WRITE(4,*)'[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' ELSE WRITE(4,*)'P[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(4,*)'V[',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),']' WRITE(4,*)'[',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),']' WRITE(4,*)'[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' END IF 5715 CONTINUE DO 5717, TEMP=1,J IF (TTYPE(TEMP) .EQ. 2) THEN WRITE(7,990)'CALL DASLNA(3,20)' WRITE(7,999)'CALL MOVE(',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),')' WRITE(7,999)'CALL DRAW(',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),')' WRITE(7,999)'CALL DRAW(',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),')' WRITE(7,999)'CALL DRAW(',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),')' WRITE(7,990)'CALL DASLNA(1,20)' ELSE WRITE(7,999)'CALL MOVE(',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),')' WRITE(7,999)'CALL DRAW(',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),')' WRITE(7,999)'CALL DRAW(',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),')' WRITE(7,999)'CALL DRAW(',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),')' END IF 5717 CONTINUE 5720 IF (K .EQ. 0) GOTO 5730 DO 5725, TEMP=1,K IF (CTYPE(TEMP) .EQ. 2) THEN WRITE(4,*)'P[',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),']' WRITE(4,*)'P[]C(W(P4(M5)))' WRITE(4,*)'(A',ANGLE(TEMP),')[',CIRCLE(TEMP,2),',', $ CIRCLE(TEMP,5),']' ELSE WRITE(4,*)'P[',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),']' WRITE(4,*)'C(A',ANGLE(TEMP),')[',CIRCLE(TEMP,2),',', $ CIRCLE(TEMP,5),']' END IF 5725 CONTINUE DO 5727, TEMP=1,K IF (CTYPE(TEMP) .EQ. 2) THEN WRITE(7,990)'CALL DASLNA(3,20)' WRITE(7,999)'CALL MOVE(',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),')' WRITE(7,991)'CALL ARCREL(',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4), $ ',-',ABS(RADIUS(TEMP)),',',ANGS(TEMP),',',ANGLE(TEMP),')' WRITE(7,990)'CALL DASLNA(1,20)' ELSE WRITE(7,999)'CALL MOVE(',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),')' WRITE(7,991)'CALL ARCREL(',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4), $ ',-',ABS(RADIUS(TEMP)),',',ANGS(TEMP),',',ANGLE(TEMP),')' END IF 5727 CONTINUE 5730 IF (M .EQ. 0) GOTO 5740 DO 5735, TEMP=1,M WRITE(4,*)'P[',POINT(TEMP,1),',',POINT(TEMP,2),']' WRITE(4,*)'C[+2]' WRITE(4,*)'[+1]' WRITE(4,*)'P[-2]' WRITE(4,*)'C[+1]' 5735 CONTINUE DO 5737, TEMP=1,M WRITE(7,999)'CALL MOVE(',POINT(TEMP,1),',',POINT(TEMP,2),')' WRITE(7,998)'CALL ARCREL(',POINT(TEMP,1),',',POINT(TEMP,2), $ ',-3.0,0.0,360.0)' WRITE(7,998)'CALL ARCREL(',POINT(TEMP,1),',',POINT(TEMP,2), $ ',-2.0,0.0,360.0)' WRITE(7,998)'CALL ARCREL(',POINT(TEMP,1),',',POINT(TEMP,2), $ ',-1.0,0.0,360.0)' 5737 CONTINUE 5740 IF(L .EQ. 0) GOTO 5750 DO 5745, TEMP=1,L IF (LTYPE(TEMP) .EQ.2) THEN WRITE(4,*)'P[',LINE(TEMP,1),',',LINE(TEMP,3),']' WRITE(4,*)'P[]V(W(P4(M5)))' WRITE(4,*)'[',LINE(TEMP,2),',',LINE(TEMP,4),']' ELSE WRITE(4,*)'P[',LINE(TEMP,1),',',LINE(TEMP,3),']' WRITE(4,*)'V[',LINE(TEMP,2),',',LINE(TEMP,4),']' END IF 5745 CONTINUE DO 5747, TEMP=1,L IF (LTYPE(TEMP) .EQ.2) THEN WRITE(7,990)'CALL DASLNA(3,20)' WRITE(7,999)'CALL MOVE(',LINE(TEMP,1),',',LINE(TEMP,3),')' WRITE(7,999)'CALL DRAW(',LINE(TEMP,2),',',LINE(TEMP,4),')' WRITE(7,990)'CALL DASLNA(1,20)' ELSE WRITE(7,999)'CALL MOVE(',LINE(TEMP,1),',',LINE(TEMP,3),')' WRITE(7,999)'CALL DRAW(',LINE(TEMP,2),',',LINE(TEMP,4),')' END IF 5747 CONTINUE 5750 IF (ND .EQ. 0) GOTO 5760 DO 5755, TEMP=1,ND WRITE(4,*)'P[',ADOWN(TEMP,1),',',ADOWN(TEMP,2),']' WRITE(4,*)'V[-5,-5]' WRITE(4,*)'P[',ADOWN(TEMP,1),',',ADOWN(TEMP,2),']' WRITE(4,*)'V[+5,-5]' 5755 CONTINUE DO 5757, TEMP=1,ND WRITE(7,999)'CALL MOVE(',ADOWN(TEMP,1),',',ADOWN(TEMP,2),')' WRITE(7,999)'CALL DRAW(',ADOWN(TEMP,1)-5,',',ADOWN(TEMP,2)-5,')' WRITE(7,999)'CALL MOVE(',ADOWN(TEMP,1),',',ADOWN(TEMP,2),')' WRITE(7,999)'CALL DRAW(',ADOWN(TEMP,1)+5,',',ADOWN(TEMP,2)-5,')' 5757 CONTINUE 5760 IF (NR .EQ. 0) GOTO 5770 DO 5765, TEMP=1,NR WRITE(4,*)'P[',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),']' WRITE(4,*)'V[-5,-5]' WRITE(4,*)'P[',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),']' WRITE(4,*)'V[-5,+5]' 5765 CONTINUE DO 5767, TEMP=1,NR WRITE(7,999)'CALL MOVE(',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),')' WRITE(7,999)'CALL DRAW(',ARIGHT(TEMP,1)-5,',',ARIGHT(TEMP,2)+5,')' WRITE(7,999)'CALL MOVE(',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),')' WRITE(7,999)'CALL DRAW(',ARIGHT(TEMP,1)-5,',',ARIGHT(TEMP,2)-5,')' 5767 CONTINUE 5770 IF (NU .EQ. 0) GOTO 5780 DO 5775, TEMP=1,NU WRITE(4,*)'P[',AUP(TEMP,1),',',AUP(TEMP,2),']' WRITE(4,*)'V[-5,+5]' WRITE(4,*)'P[',AUP(TEMP,1),',',AUP(TEMP,2),']' WRITE(4,*)'V[+5,+5]' 5775 CONTINUE DO 5777, TEMP=1,NU WRITE(7,999)'CALL MOVE(',AUP(TEMP,1),',',AUP(TEMP,2),')' WRITE(7,999)'CALL DRAW(',AUP(TEMP,1)-5,',',AUP(TEMP,2)+5,')' WRITE(7,999)'CALL MOVE(',AUP(TEMP,1),',',AUP(TEMP,2),')' WRITE(7,999)'CALL DRAW(',AUP(TEMP,1)+5,',',AUP(TEMP,2)+5,')' 5777 CONTINUE 5780 IF (NL .EQ. 0) GOTO 5790 DO 5785, TEMP=1,NL WRITE(4,*)'P[',ALEFT(TEMP,1),',',ALEFT(TEMP,2),']' WRITE(4,*)'V[+5,-5]' WRITE(4,*)'P[',ALEFT(TEMP,1),',',ALEFT(TEMP,2),']' WRITE(4,*)'V[+5,+5]' 5785 CONTINUE DO 5787, TEMP=1,NL WRITE(7,999)'CALL MOVE(',ALEFT(TEMP,1),',',ALEFT(TEMP,2),')' WRITE(7,999)'CALL DRAW(',ALEFT(TEMP,1)+5,',',ALEFT(TEMP,2)-5,')' WRITE(7,999)'CALL MOVE(',ALEFT(TEMP,1),',',ALEFT(TEMP,2),')' WRITE(7,999)'CALL DRAW(',ALEFT(TEMP,1)+5,',',ALEFT(TEMP,2)+5,')' 5787 CONTINUE 5790 IF (Q .EQ. 0) GOTO 5799 DO 5795, TEMP=1,Q WRITE(4,*)'P[',TEXT(TEMP,1),',',TEXT(TEMP,2),']' IF (TYPE(TEMP).EQ.1) WRITE(4,*)'T(S0,H1)''' IF (TYPE(TEMP).EQ.2) WRITE(4,*)'T(S0,H0)''' IF (TYPE(TEMP).EQ.3) WRITE(4,*)'T(S2,H3)''' WRITE(4,*)(QUOTE(TEMP2), TEMP2=START(TEMP),FINISH(TEMP)) 5795 CONTINUE DO 5797, TEMP=1,Q WRITE(7,999)'CALL MOVE(',TEXT(TEMP,1),',',TEXT(TEMP,2),')' IF (TYPE(TEMP).EQ.1) WRITE(7,995)'CALL CSIZEA(5.,1.1,0.0)' IF (TYPE(TEMP).EQ.2) WRITE(7,995)'CALL CSIZEA(9.0,.7,0.0)' IF (TYPE(TEMP).EQ.3) WRITE(7,995)'CALL CSIZEA(13.,.85,0.0)' WRITE(7,994)'CALL LABON(80)' DO 5796, N=START(TEMP),FINISH(TEMP) TEMPC=QUOTE(N) QM=INDEX(TEMPC,'''') IF (QM .EQ. 0) THEN LAST=50 11111 IF ((TEMPC(LAST:LAST).EQ.' ').AND. $ (LAST.NE.1)) THEN LAST=LAST-1 GOTO 11111 ELSE TEMPC(LAST+1:LAST+1)='''' QUOTE(N)=TEMPC(1:LAST+1) END IF WRITE(7,996)'PRINT*,''',QUOTE(N) ELSE WRITE(7,993)'PRINT*,''',QUOTE(N) END IF 5796 CONTINUE WRITE(7,994)'CALL LABOFF' 5797 CONTINUE 5799 WRITE(7,*)' CALL NEWPEN(0)' WRITE(7,*)' CALL PLOT(0.0,0.0,999)' WRITE(7,*)' END' WRITE(4,95) ESC,'\' WRITE(6,91)ESC,'Pp' WRITE(6,*)'S(A[0,0][799,479])' WRITE(6,95)ESC,'\' 90 FORMAT(X,A1,A2) 91 FORMAT (X,A1,A2) 92 FORMAT(' R(P(I))') 93 FORMAT(A80) 95 FORMAT(X,A1,A1) 990 FORMAT(7X,A18) 991 FORMAT(7X,A12,F8.2,A1,F6.2,A2,F6.2,A1,F6.2,A1,F6.2,A1) 993 FORMAT(7X,A8,A50) 994 FORMAT(7X,A15) 995 FORMAT(7X,A25) 996 FORMAT(7X,A8,A50,A1) 997 FORMAT(7X,A12,F8.2,A1,F6.2,A2,F6.2,A11) 998 FORMAT(7X,A12,F8.2,A1,F6.2,A16) 999 FORMAT(7X,A10,F8.2,A1,F6.2,A1) END SUBROUTINE CONVERT(POSITION,X,Y) C SUBROUTINE TO CONVERT THE CHARACTER STRING FROM THE REPORT POSITION C COMMAND, INTO TWO NUMBERS. CHARACTER*80 POSITION CHARACTER*5 XVAL,YVAL INTEGER LB,CO,RB,X,Y,A,B XVAL=' ' YVAL=' ' LB=INDEX(POSITION,'[') CO=INDEX(POSITION,',') RB=INDEX(POSITION,']') XVAL=POSITION(LB+1:CO-1) YVAL=POSITION(CO+1:RB-1) A=CO-LB-1 B=RB-CO-1 IF (A .EQ. 5) GOTO 30 IF (A .EQ. 4) GOTO 40 IF (A .EQ. 3) GOTO 50 IF (A .EQ. 2) GOTO 60 IF (A .EQ. 1) GOTO 70 30 DECODE(5,35,XVAL) X 35 FORMAT(I5) GOTO 76 40 DECODE(5,45,XVAL) X 45 FORMAT(I4,X) GOTO 76 50 DECODE(5,55,XVAL) X 55 FORMAT(I3,2X) GOTO 76 60 DECODE(5,65,XVAL) X 65 FORMAT(I2,3X) GOTO 76 70 DECODE(5,75,XVAL) X 75 FORMAT(I1,4X) 76 IF (B .EQ. 5) GOTO 80 IF (B .EQ. 4) GOTO 83 IF (B .EQ. 3) GOTO 85 IF (B .EQ. 2) GOTO 90 IF (B .EQ. 1) GOTO 100 80 DECODE(5,82,YVAL) Y 82 FORMAT(I5) GOTO 110 83 DECODE(5,84,YVAL) Y 84 FORMAT(I4,X) GOTO 110 85 DECODE(5,87,YVAL) Y 87 FORMAT(I3,2X) GOTO 110 90 DECODE(5,95,YVAL) Y 95 FORMAT(I2,3X) GOTO 110 100 DECODE(5,105,YVAL) Y 105 FORMAT(I1,4X) 110 RETURN END SUBROUTINE SETUP(ICOUNT,J,K,L,M,ND,NR,NU,NL,BOX,TRIANGLE,CIRCLE,POINT, $ LINE,ADOWN,ARIGHT,AUP,ALEFT,S,TEXT,Q,START,FINISH,TYPE,QUOTE, $ LTYPE,CTYPE,ANGLE,BTYPE,TTYPE) C C THIS IS A SUBROUTINE TO CLEAR THE SCREEN AND THEN TO DRAW THE OBJECTS C THAT HAVE BEEN ENTERED. REAL LINE INTEGER Q,START,FINISH,TYPE,CTYPE,TTYPE,BTYPE DIMENSION BOX(100,4),TRIANGLE(100,6),CIRCLE(100,6),POINT(100,2) DIMENSION LINE(500,4),ADOWN(100,2),ARIGHT(100,2),TYPE(300),FINISH(300) DIMENSION AUP(100,2),ALEFT(100,2),X(3),Y(3),START(300),TEXT(300,2) DIMENSION LTYPE(500),CTYPE(100),ANGLE(100),BTYPE(100),TTYPE(100) CHARACTER*80 QUOTE(500) BYTE ESC,CSI ESC=27 CSI=155 WRITE(6,90) CSI,'2J' WRITE(6,91) ESC,'Pp' IF (S .EQ. 0) WRITE(6,*)'S(A[0,0][799,479])' IF (ICOUNT .EQ. 0) GOTO 8 DO 7,TEMP=1,ICOUNT IF (BTYPE(TEMP) .EQ. 2) THEN WRITE(6,*)'P[',BOX(TEMP,1),',',BOX(TEMP,3),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',BOX(TEMP,2),']' WRITE(6,*)'[,',BOX(TEMP,4),']' WRITE(6,*)'[',BOX(TEMP,1),']' WRITE(6,*)'[,',BOX(TEMP,3),']' ELSE WRITE(6,*)'P[',BOX(TEMP,1),',',BOX(TEMP,3),']' WRITE(6,*)'V[',BOX(TEMP,2),']' WRITE(6,*)'[,',BOX(TEMP,4),']' WRITE(6,*)'[',BOX(TEMP,1),']' WRITE(6,*)'[,',BOX(TEMP,3),']' END IF 7 CONTINUE 8 IF (J .EQ. 0) GOTO 10 DO 9,TEMP= 1,J IF (TTYPE(TEMP) .EQ. 2) THEN WRITE(6,*)'P[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),']' WRITE(6,*)'[',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),']' WRITE(6,*)'[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' ELSE WRITE(6,*)'P[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' WRITE(6,*)'V[',TRIANGLE(TEMP,2),',',TRIANGLE(TEMP,5),']' WRITE(6,*)'[',TRIANGLE(TEMP,3),',',TRIANGLE(TEMP,6),']' WRITE(6,*)'[',TRIANGLE(TEMP,1),',',TRIANGLE(TEMP,4),']' END IF 9 CONTINUE 10 IF (K .EQ. 0) GOTO 12 DO 11,TEMP=1,K IF (CTYPE(TEMP) .EQ. 2) THEN WRITE(6,*)'P[',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),']' WRITE(6,*)'P[]C(W(P4(M5)))' WRITE(6,*)'(A',ANGLE(TEMP),')' WRITE(6,*)'[',CIRCLE(TEMP,2),',',CIRCLE(TEMP,5),']' ELSE WRITE(6,*)'P[',CIRCLE(TEMP,1),',',CIRCLE(TEMP,4),']' WRITE(6,*)'C(A',ANGLE(TEMP),')' WRITE(6,*)'[',CIRCLE(TEMP,2),',',CIRCLE(TEMP,5),']' END IF 11 CONTINUE 12 IF (M .EQ. O) GOTO 14 DO 13,TEMP=1,M WRITE(6,*)'P[',POINT(TEMP,1),',',POINT(TEMP,2),']' WRITE(6,*)'C[+2]' WRITE(6,*)'[+1]' WRITE(6,*)'P[-2]' WRITE(6,*)'C[+1]' 13 CONTINUE 14 IF (L .EQ. 0) GOTO 16 DO 15,TEMP=1,L IF (LTYPE(TEMP) .EQ.2) THEN WRITE(6,*)'P[',LINE(TEMP,1),',',LINE(TEMP,3),']' WRITE(6,*)'P[]V(W(P4(M5)))' WRITE(6,*)'[',LINE(TEMP,2),',',LINE(TEMP,4),']' ELSE WRITE(6,*)'P[',LINE(TEMP,1),',',LINE(TEMP,3),']' WRITE(6,*)'V[',LINE(TEMP,2),',',LINE(TEMP,4),']' END IF 15 CONTINUE 16 IF (ND .EQ. 0) GOTO 18 DO 17,TEMP=1,ND WRITE(6,*)'P[',ADOWN(TEMP,1),',',ADOWN(TEMP,2),']' WRITE(6,*)'V[-5,-5]' WRITE(6,*)'P[',ADOWN(TEMP,1),',',ADOWN(TEMP,2),']' WRITE(6,*)'V[+5,-5]' 17 CONTINUE 18 IF (NR .EQ. 0) GOTO 20 DO 19,TEMP=1,NR WRITE(6,*)'P[',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),']' WRITE(6,*)'V[-5,-5]' WRITE(6,*)'P[',ARIGHT(TEMP,1),',',ARIGHT(TEMP,2),']' WRITE(6,*)'V[-5,+5]' 19 CONTINUE 20 IF (NU .EQ. 0) GOTO 22 DO 21,TEMP=1,NU WRITE(6,*)'P[',AUP(TEMP,1),',',AUP(TEMP,2),']' WRITE(6,*)'V[-5,+5]' WRITE(6,*)'P[',AUP(TEMP,1),',',AUP(TEMP,2),']' WRITE(6,*)'V[+5,+5]' 21 CONTINUE 22 IF (NL .EQ. 0) GOTO 24 DO 23,TEMP=1,NL WRITE(6,*)'P[',ALEFT(TEMP,1),',',ALEFT(TEMP,2),']' WRITE(6,*)'V[+5,-5]' WRITE(6,*)'P[',ALEFT(TEMP,1),',',ALEFT(TEMP,2),']' WRITE(6,*)'V[+5,+5]' 23 CONTINUE 24 IF (Q .EQ. 0) GOTO 50 DO 40, TEMP=1,Q WRITE(6,*)'P[',TEXT(TEMP,1),',',TEXT(TEMP,2),']' IF (TYPE(TEMP).EQ.1) WRITE(6,*)'T(S0,H1)''' IF (TYPE(TEMP).EQ.2) WRITE(6,*)'T(S0,H0)''' IF (TYPE(TEMP).EQ.3) WRITE(6,*)'T(S2,H3)''' WRITE(6,*)(QUOTE(N), N=START(TEMP),FINISH(TEMP)) 40 CONTINUE 50 RETURN 90 FORMAT(X,A1,A2) 91 FORMAT (X,A1,A2) 95 FORMAT(X,A1,A1) END