C C SIMPLE DRAWING PROGRAM USING DECGRAPHIC-11 SOFTWARE C C HOST SIDE OF HOST/SATELLITE VERSION C USES INTEGER MODE, LOCAL SAVE/RSTR, C AND LK11 PUSH BUTTON BOX C COMMON/PDATA/NPRIM(209),NVPRIM(209),NDEF,NHID LOGICAL*1 FILE1(16),FILE2(16),USED(5) INTEGER GRD,SM,YTOP,X,Y,XX,YY,X0,Y0,X1,Y1,X2,Y2, X ZERO,TWO,FOUR,THREEC,SIZE,FIVEC DATA USED/48,0,0,37,0/ SIZE=4096 GRD=50 SM=50 YTOP=750 ZERO=0 TWO=2 FOUR=4 ONEC=100 THREEC=300 FIVEC=500 IWARN=15 MARGIN=10 NDEF=0 NHID=0 ISAC=0 DO 10 I=1,209 NVPRIM(I)=0 10 NPRIM(I)=0 C C SET UP MENU AREAS C CALL INIT(4096) CALL SUBP(1000) CALL OFF(1000) CALL SUBP(1001) CALL MENU(,YTOP,-SM,2010,'DRAW','MOVE','COMBINE','SCALE', X 'COPY','ERASE','MODIFY','HIDE','SEEK') CALL MENU(,YTOP-9*SM,-SM,2019,'SEEK & COPY','ROTATE','SAVE', X 'RECALL','EXIT') CALL ESUB CALL SUBP(1002) CALL MENU(,THREEC,-SM,1020,'POSITION','LINE','CLOSE','DONE') CALL ESUB CALL MENU(,THREEC,ZERO,1003,'DONE') CALL SUBP(1004) CALL MENU(,THREEC,-SM,1030,'1/4','1/2','2 X','4 X') CALL ESUB CALL SUBP(1005) CALL MENU(,THREEC,-SM,1040,'ERASE LINE','SPLIT LINE', X 'MOVE CORNER','SHOW ALL','DONE') CALL ESUB CALL SUBP(1006) CALL MENU(,THREEC,-SM,1050,'90 CW','180','90 CCW') CALL ESUB CALL SUBP(2006) CALL AREA(2) CALL APNT(ZERO,ZERO,,-4) CALL TEXT(' ') CALL ESUB(2006) C C MAIN LOOP -- WAIT FOR MENU HIT AND BRANCH TO SERVICE IT C 100 DO 110 I=1002,1006 110 CALL OFF(I) CALL ON(1001) CALL ON(1000) CALL DPTR(I) CALL POINTR(2,2006,2) I=(SIZE-I)/(SIZE/100) CALL FLASH(2,IWARN-I) USED(3)=I-I/10*10+48 USED(2)=I/10+48 CALL CHANGT(2,USED) CALL MENUH(IT,2010,2023) CALL OFF(1001) GOTO (1100,1600,1700,1800,1900,2000,2100,2200,2300,2600,2700, X 2400,2500,5000),IT C C DRAW A NEW OBJECT C 1100 IF(I.LT.MARGIN)GOTO 4000 CALL ON(1002) CALL MAKOBJ(NOBJ) CALL SUBP(NOBJ) CALL APNT(FIVEC,FIVEC,1,-4) CALL POINTR(2,NOBJ) XX=FIVEC YY=FIVEC 1110 CALL ATTACH(2) CALL TRAK(XX,YY) CALL MENUH(IT,1020,1023) CALL GRID(GRD,GRD) CALL TRAKXY(XX,YY) CALL ERAS CALL GET(2,X,Y) IF(IABS(X).LT.GRD.AND.IABS(Y).LT.GRD.AND.NPRIM(NOBJ).NE.0) X GOTO 1110 II=-10 GOTO(1140,1120,1160,1180),IT 1120 II=10 NVPRIM(NOBJ)=NVPRIM(NOBJ)+1 1140 NPRIM(NOBJ)=NPRIM(NOBJ)+1 CALL LVECT(ZERO,ZERO,,II) CALL ADVANC(2) GOTO 1110 1160 II=10 1180 CALL POINTR(2,NOBJ) CALL GET(2,X0,Y0) X=X0-XX Y=Y0-YY IF(IABS(X).LT.GRD.AND.IABS(Y).LT.GRD)GOTO 1185 CALL LVECT(X,Y,,II) IF(II.GT.0)NVPRIM(NOBJ)=NVPRIM(NOBJ)+1 NPRIM(NOBJ)=NPRIM(NOBJ)+1 1185 CALL ESUB IF(NVPRIM(NOBJ).EQ.0)GOTO 1190 NDEF=NDEF+1 GOTO 100 1190 CALL ERAS(NOBJ) NPRIM(NOBJ)=0 GOTO 100 C C MOVE AN OBJECT C 1600 IF(NDEF.EQ.0)GOTO 100 CALL ON(1003) CALL PICKOB(IT,2) CALL POINTR(2,IT) CALL GET(2,XX,YY) CALL ATTACH(2) CALL TRAK(XX,YY) CALL MENUH(IT,1003,1003) CALL GRID(GRD,GRD) CALL ERAS GOTO 100 C C COMBINE TWO OBJECTS C 1700 IF(I.LT.MARGIN)GOTO 4000 IF(NDEF.LT.2)GOTO 100 CALL PICKOB(IT,2) 1710 CALL PICKOB(IT2,3) IF(IT2.EQ.IT)GOTO 1710 CALL MAKOBJ(NOBJ) CALL SUBP(NOBJ) CALL COPY(,IT) CALL GET(2,X1,Y1) CALL GET(3,X2,Y2) CALL LVECT(X2-X1,Y2-Y1,,-10) CALL OFF(IT2) CALL ERASP(3) CALL COPY(,IT2) CALL LVECT(X1-X2,Y1-Y2,,-10) CALL ESUB NPRIM(NOBJ)=NPRIM(IT)+NPRIM(IT2)+2 NVPRIM(NOBJ)=NVPRIM(IT)+NVPRIM(IT2) NDEF=NDEF-1 CALL ERAS(IT) CALL ERAS(IT2) NPRIM(IT)=0 NPRIM(IT2)=0 NVPRIM(IT)=0 NVPRIM(IT2)=0 GOTO 100 C C SCALE AN OBJECT C 1800 IF(NDEF.EQ.0)GOTO 100 CALL ON(1004) CALL MENUH(IT2,1030,1033) CALL PICKOB(IT,2) CALL OFF(IT) XX=ZERO YY=ZERO DO 1830 I=1,NPRIM(IT) CALL ADVANC(2) CALL GET(2,X,Y) GOTO (1805,1810,1815,1820),IT2 1805 CALL CHANGE(2,X/FOUR,Y/FOUR) GOTO 1825 1810 CALL CHANGE(2,X/TWO,Y/TWO) GOTO 1825 1815 CALL CHANGE(2,X*TWO,Y*TWO) GOTO 1825 1820 CALL CHANGE(2,X*FOUR,Y*FOUR) 1825 CALL GET(2,X,Y) XX=XX+X 1830 YY=YY+Y 1840 CALL GET(2,X,Y) CALL CHANGE(2,X-XX,Y-YY) CALL ON(IT) GOTO 100 C C COPY AN OBJECT C 1900 IF(I.LT.MARGIN)GOTO 4000 IF(NDEF.EQ.0)GOTO 100 CALL ON(1003) CALL PICKOB(IT,2) 1910 CALL MAKOBJ(NOBJ) CALL COPY(NOBJ,IT) CALL POINTR(2,NOBJ) CALL GET(2,X,Y) CALL ATTACH(2) CALL TRAK(X,Y) CALL MENUH(IT2,1003,1003) CALL GRID(GRD,GRD) CALL ERAS NDEF=NDEF+1 NPRIM(NOBJ)=NPRIM(IT) NVPRIM(NOBJ)=NVPRIM(IT) IF(ISAC.EQ.0)GOTO 100 ISAC=0 GOTO 2210 C C ERASE AN OBJECT C 2000 IF(NDEF.EQ.0)GOTO 100 CALL PICKOB(IT,2) CALL ERAS(IT) NDEF=NDEF-1 NVPRIM(IT)=0 NPRIM(IT)=0 GOTO 100 C C MODIFY AN OBJECT C 2100 IF(NDEF.EQ.0)GOTO 100 CALL ON(1005) CALL MENUH(IT2,1040,1044) 2105 IF(IT2.EQ.5)GOTO 100 2110 CALL GRATTN(1,IT,1) CALL LPEN(IH,IT,,,IP) IF(IH.EQ.0.OR.IT.LT.1.OR.IT.GT.209)GOTO 2110 CALL POINTR(5,IT,IP) GOTO (2120,2140,2130,2170),IT2 C C ERASE A LINE C 2120 CALL INTENS(5,-10) NVPRIM(IT)=NVPRIM(IT)-1 IF(NVPRIM(IT).GT.0)GOTO 2100 CALL ERAS(IT) NPRIM(IT)=0 NDEF=NDEF-1 GOTO 2100 C C MOVE A CORNER C 2130 IF(IP.NE.NPRIM(IT)+1)GOTO 2150 CALL POINTR(4,IT) CALL ATTACH(4) CALL POINTR(6,IT,2) GOTO 2155 C C SPLIT A LINE C 2140 CALL GET(5,X,Y) CALL OFF(1000) CALL CHANGE(5,X/TWO,Y/TWO) CALL POINTR(2,IT,IP+1) CALL INSERT(2) CALL LVECT(X-X/TWO,Y-Y/TWO) CALL INSERT CALL ON(1000) NPRIM(IT)=NPRIM(IT)+1 NVPRIM(IT)=NVPRIM(IT)+1 2150 CALL POINTR(6,IT,IP+1) 2155 CALL ATTACH(5) CALL ATTACH(6,-1) CALL POINTR(2,IT) CALL GET(2,X,Y) DO 2160 I=1,IP-1 CALL ADVANC(2) CALL GET(2,XX,YY) X=X+XX 2160 Y=Y+YY CALL TRAK(X,Y) CALL MENUH(IT2,1040,1044) CALL GRID(GRD,GRD) CALL ERAS GOTO 2105 C C SHOW ALL LINES C 2170 CALL POINTR(5,IT) DO 2180 I=1,NPRIM(IT) CALL ADVANC(5) 2180 CALL INTENS(5) NVPRIM(IT)=NPRIM(IT) GOTO 2100 C C HIDE AN OBJECT C 2200 IF(NDEF.EQ.0)GOTO 100 CALL PICKOB(IT,2) 2210 CALL OFF(IT) NVPRIM(IT)=-NVPRIM(IT) NDEF=NDEF-1 NHID=NHID+1 GOTO 100 C C SEEK AN OBJECT C 2300 IF(NHID.EQ.0)GOTO 100 2305 DO 2310 I=1,200 IF(NVPRIM(I).LT.0)CALL ON(I) 2310 IF(NVPRIM(I).GT.0)CALL OFF(I) CALL PICKOB(IT,2) NVPRIM(IT)=-NVPRIM(IT) NDEF=NDEF+1 NHID=NHID-1 DO 2320 I=1,200 IF(NVPRIM(I).LT.0)CALL OFF(I) 2320 IF(NVPRIM(I).GT.0)CALL ON(I) IF(ISAC)1910,100,1910 C C SAVE THE DISPLAY C 2400 CALL INFILE(1,FILE1,FILE2,I) IF(I.NE.0)GOTO 2450 CALL STOP CALL ASSIGN(2,FILE2) DEFINE FILE 2(2,256,U,INDX) WRITE(2'1)(NPRIM(I),I=1,256) WRITE(2'2)(NPRIM(I),I=257,420),(J,J=421,512) CALL CLOSE(2) CALL SAVE(FILE1) CALL LPEN(IH,IT) GOTO 100 2450 DO 2460 I=1,420,20 2460 CALL TOOSAT(40,NPRIM(I)) CALL LPEN(IH,IT) GOTO 100 C C RECALL A DISPLAY FILE C 2500 CALL INFILE(0,FILE1,FILE2,I) IF(I.NE.0)GOTO 2550 CALL STOP CALL ASSIGN(2,FILE2) DEFINE FILE 2 (2,256,U,INDX) READ(2'1)(NPRIM(I),I=1,256) READ(2'2)(NPRIM(I),I=257,420),(K,J=421,512) CALL CLOSE(2) CALL INIT CALL RSTR(FILE1) CALL LPEN(IH,IT) GOTO 100 2550 DO 2560 I=1,420,20 2560 CALL FRSAT(1,40,NPRIM(I)) CALL LPEN(IH,IT) GOTO 100 C C SEEK AND COPY C 2600 IF(I.LT.MARGIN)GOTO 4000 IF(NHID.EQ.0)GOTO 100 CALL ON(1003) ISAC=1 GOTO 2305 C C ROTATE C 2700 IF(NDEF.EQ.0)GOTO 100 CALL ON(1006) CALL MENUH(IT2,1050,1052) CALL PICKOB(IT,2) CALL OFF(IT) DO 2750 I=1,NPRIM(IT) CALL ADVANC(2) CALL GET(2,X,Y) GOTO(2710,2720,2730),IT2 2710 CALL CHANGE(2,Y,-X) GOTO 2750 2720 CALL CHANGE(2,-X,-Y) GOTO 2750 2730 CALL CHANGE(2,-Y,X) 2750 CONTINUE CALL ON(IT) GOTO 100 4000 CALL CMPRS GOTO 100 5000 CALL FREE STOP END SUBROUTINE MENUH(IT,M1,M2) C C GET A MENU HIT C CALL TOSAT(102,2,2,M1,2,M2) CALL FRSAT(1,1,IT) RETURN END SUBROUTINE PICKOB(IT,IP) C C PICK AN OBJECT C CALL TOSAT(103,1,1,IP) CALL FRSAT(1,2,IT) RETURN END SUBROUTINE INFILE(IFUN,FILE1,FILE2,I) C C INPUT A FILE NAME C CALL TOSAT(101,1,1,IFUN) CALL FRSAT(3,11,FILE1,11,FILE2,1,I) RETURN END SUBROUTINE MAKOBJ(NOBJ) COMMON/PDATA/NPRIM(209),NVPRIM(209),NDEF,NHID DO 100 NOBJ=1,209 IF(NVPRIM(NOBJ).EQ.0)RETURN 100 CONTINUE STOP END