C C SIMPLE DRAWING PROGRAM USING THE NEW GRAPHICS PACKAGE C C STAND ALONE VERSION C USES REAL MODE, LIGHT PEN ATTENTIONS ONLY C COMMON/DFILE/IBUF(4096) COMMON/PDATA/NPRIM(209),NVPRIM(209),NDEF,NHID REAL SF(4) LOGICAL*1 FILE1(16),FILE2(16),USED(5) DATA SF/.25,.5,2.,4./ DATA USED/48,0,0,37,0/ SIZE=4096. GRD=50. SM=50. YTOP=750. IWARN=15 MARGIN=10 NDEF=0 NHID=0 ISAC=0 DO 10 I=1,200 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(,300.,-SM,1020,'POSITION','LINE','CLOSE','DONE') CALL ESUB CALL MENU(,300.,0.,1003,'DONE') CALL SUBP(1004) CALL MENU(,300.,-SM,1030,'1/4','1/2','2 X','4 X') CALL ESUB CALL SUBP(1005) CALL MENU(,300.,-SM,1040,'ERASE LINE','SPLIT LINE', X 'MOVE CORNER','SHOW ALL','DONE') CALL ESUB CALL SUBP(1006) CALL MENU(,300.,-SM,1050,'90 CW','180','90 CCW') CALL ESUB CALL SUBP(2006) CALL AREA(2) CALL APNT(0.,0.,,-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(500.,500.,1,-4) CALL POINTR(2,NOBJ) XX=500. YY=500. 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(ABS(X).LT.GRD.AND.ABS(Y).LT.GRD.AND.NPRIM(NOBJ).NE.0) X GOTO 1110 II=-4 GOTO(1140,1120,1160,1180),IT 1120 II=4 NVPRIM(NOBJ)=NVPRIM(NOBJ)+1 1140 NPRIM(NOBJ)=NPRIM(NOBJ)+1 CALL LVECT(0.,0.,,II) CALL ADVANC(2) GOTO 1110 1160 II=4 1180 CALL POINTR(2,NOBJ) CALL GET(2,X0,Y0) X=X0-XX Y=Y0-YY IF(ABS(X).LT.GRD.AND.ABS(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,,-4) CALL OFF(IT2) CALL ERASP(3) CALL COPY(,IT2) CALL LVECT(X1-X2,Y1-Y2,,-4) 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=0. YY=0. DO 1830 I=1,NPRIM(IT) CALL ADVANC(2) CALL GET(2,X,Y) CALL CHANGE(2,X*SF(IT2),Y*SF(IT2)) 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/2.,Y/2.) CALL POINTR(2,IT,IP+1) CALL INSERT(2) CALL LVECT(X/2.,Y/2.) 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(FILE1,FILE2) 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 C C RECALL A DISPLAY FILE C 2500 CALL INFILE(FILE1,FILE2) 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,I=421,512) CALL CLOSE(2) CALL INIT CALL RSTR(FILE1) 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 WAIT FOR MENU HIT C 100 CALL GRATTN(1,I,1) CALL LPEN(IH,IT) IF(IH.EQ.0.OR.IT.LT.M1.OR.IT.GT.M2)GOTO 100 CALL POINTR(10,IT) CALL INTENS(10,8) CALL WAIT(5000) CALL LPEN(IH,IX) CALL INTENS(10,4) IT=IT+1-M1 RETURN END SUBROUTINE PICKOB(IT,IP) C C PICK AN OBJECT C COMMON/DFILE/IBUF(4096) COMMON/PDATA/NPRIM(209),NVPRIM(209),NDEF,NHID 100 CALL GRATTN(1,I,1) CALL LPEN(IH,IT) IF(IH.EQ.0.OR.IT.LT.1.OR.IT.GT.209)GOTO 100 CALL POINTR(IP,IT) CALL INTENS(IP,-8) CALL WAIT(5000) CALL INTENS(IP,-4) RETURN END SUBROUTINE INFILE(FILE1,FILE2) C C INPUT A FILE NAME C LOGICAL*1 FILE1(16),FILE2(16),DSP(5),DAT(5) DATA DSP,DAT/'.','D','S','P',0,'.','D','A','T',0/ 1 CALL TTW(0,'FILENAME : ',-1) CALL KBS(16,FILE1,N) IF(N.EQ.0)GOTO 1 DO 100 I=1,N 100 FILE2(I)=FILE1(I) DO 200 I=1,5 FILE1(I+N)=DSP(I) 200 FILE2(I+N)=DAT(I) RETURN END SUBROUTINE MAKOBJ(NOBJ) COMMON/DFILE/IBUF(4096) COMMON/PDATA/NPRIM(209),NVPRIM(209),NDEF,NHID DO 100 NOBJ=1,209 IF(NVPRIM(NOBJ).EQ.0)RETURN 100 CONTINUE STOP END