PROGRAM TEST * Test program for graphics IMPLICIT INTEGER(A-Z) CHARACTER CH INTEGER*2 HWTYP,TXMODE,GRMODE,NGXPH,NGYPH,NCOLRS,MONITO INTEGER*2 CHW,CHH,CHCW,CHCH,SEGS,OFFS INTEGER*2 VSEG,DLIN1,DLIN2,DLIN4,WRIMOD,REMAP CHARACTER*8 HWNAME(0:5) CHARACTER*8 MONAME(0:3) CHARACTER*8 MANAME(0:3) COMMON/G0HWD/HWTYP,TXMODE,GRMODE,NGXPH,NGYPH,NCOLRS,MONITO COMMON/G0HWD/CHW,CHH,CHCW,CHCH,SEGS(0:1),OFFS(0:1) COMMON/G0HWD/VSEG,DLIN1,DLIN2,DLIN4,WRIMOD,REMAP DATA HWNAME/'BIOS ','EGA/VGA ','CGA ','Hercules', & 'Siemens ','MCGA '/ DATA MONAME/'Standard','EGA ','VGAgrey ','VGAcolor'/ DATA MANAME/'none ','EGA 4col','EGA16col','MCGA '/ WRITE(*,*) 'PLOT-TESTS' WRITE(*,'(/////)') WRITE(*,*) 'In the following, the subroutines of the' WRITE(*,*) 'graphics library will be tested.' WRITE(*,*) 'If you want to abort the test when graphics' WRITE(*,*) 'is active, press the key "Q"' WRITE(*,*) WRITE(*,*) 'Press ENTER to continue; Q then ENTER to quit' READ(*,'(A1)') CH IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 2000 CALL GINIT(1) CALL GINIT(-1) WRITE(*,*) 'YOUR HARDWARE' WRITE(*,*) WRITE(6,*) 'GRAPHICS BOARD:',HWNAME(HWTYP) WRITE(6,*) 'PALETTE sel. ',MANAME(REMAP) WRITE(6,*) 'MONITOR ',MONAME(MONITO) WRITE(6,*) 'TEXTMODE: ',TXMODE WRITE(6,*) 'GRAPHMODE: ',GRMODE WRITE(6,*) 'GRAPHIC COLUMNS',NGXPH+1 WRITE(6,*) 'GRAPHIC LINES ',NGYPH+1 WRITE(6,*) 'SCREEN COLORS ',NCOLRS+1 WRITE(*,*) 'Press ENTER to continue; Q then ENTER to quit' READ(*,'(A1)') CH IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 2000 CALL GINIT(1) CALL TEST1(CH) IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 1000 CALL TEST2(CH) IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 1000 CALL TEST3(CH) IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 1000 CALL TEST4(CH) IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 1000 CALL TEST5(CH) IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 1000 CALL TEST6(CH) IF (CH.EQ.'q'.OR.CH.EQ.'Q') GOTO 1000 CALL TEST7 CALL GINIT(-1) CALL TESTA(CH) GOTO 2000 1000 CALL GINIT(-1) 2000 CONTINUE END SUBROUTINE TEST1(CH) * TEST FOR GWINDO UND GLINE IMPLICIT REAL*8(A-H,O-Z) CHARACTER CH XMIN=-1 XMAX= 1 YMIN=-1 YMAX= 1 * TEST FOR GWINDO UND GLINE CALL GWINDO(XMIN,XMAX,YMIN,YMAX,0.D0,100.D0,0.D0,100.D0) CALL GLINE(XMIN,YMIN,XMIN,YMAX,1,1) CALL GLINE(XMIN,YMAX,XMAX,YMAX,1,1) CALL GLINE(XMAX,YMAX,XMAX,YMIN,1,1) CALL GLINE(XMAX,YMIN,XMIN,YMIN,1,1) CALL GLINE(XMIN,YMIN,XMAX,YMAX,1,1) CALL GLINE(XMIN,YMAX,XMAX,YMIN,1,1) CALL GWRITE(3,0.D0,0.D0, & 'White frame with x inside',1) CALL GINKEY('Press Q to quit, any other key to go on',CH) CALL GWINDO(0.D0,1.D0,0.D0,1.D0,0.D0,100.D0,0.D0,100.D0) CALL GBOX(0.D0,0.D0,1.D0,1.D0,0,2) END SUBROUTINE TEST2(CH) * TESTROUTINE FOR GMOVE,GDRAW IMPLICIT REAL*8(A-H,O-Z) CHARACTER CH PARAMETER(PI=3.1415926D0) CALL GWINDO(-1.D0,1.D0,-1.D0,1.D0,15.D0,85.D0,15.D0,85.D0) DO 10 I=1,20 H=.05*I CALL GMOVE(I,H,H,I,I) 10 CONTINUE DO 20 I=1,20 H=.05*I CALL GDRAW(I,H,-H) 20 CONTINUE DO 30 I=1,20 H=.05*I CALL GDRAW(I,-H,-H) 30 CONTINUE DO 40 I=1,20 H=.05*I CALL GDRAW(I,-H,H) 40 CONTINUE DO 50 I=1,20 H=.05*I CALL GDRAW(I,H,H) 50 CONTINUE CALL GWRITE(1,0.D0,1.D0, &'Coloured rectangles inside each other, different linetypes',1) CALL GINKEY('Press Q to quit, any other key to go on',CH) CALL GWINDO(0.D0,1.D0,0.D0,1.D0,0.D0,100.D0,0.D0,100.D0) CALL GBOX(0.D0,0.D0,1.D0,1.D0,0,2) RETURN END SUBROUTINE TEST3(CH) * TESTROUTINE FOR GBOX IMPLICIT REAL*8(A-H,O-Z) CHARACTER CH CALL GWINDO(0.D0,1.D0,0.D0,1.D0,15.D0,85.D0,15.D0,85.D0) DO 20 I=0,9 X1= .1*I X2= .1*(I+1) CALL GBOX(X1,X1,X2,X2,I,I) 20 CONTINUE CALL GWRITE(1,0.D0,1.D0, & 'Adjacent coloured boxes, different fill patterns',1) CALL GINKEY('Press Q to quit, any other key to go on',CH) CALL GWINDO(0.D0,1.D0,0.D0,1.D0,0.D0,100.D0,0.D0,100.D0) CALL GBOX(0.D0,0.D0,1.D0,1.D0,0,2) RETURN END SUBROUTINE TEST4(CH) * TESTROUTINE FOR GMARK IMPLICIT REAL*8(A-H,O-Z) CHARACTER CH CALL GWINDO(0.D0,1.D0,0.D0,1.D0,15.D0,85.D0,15.D0,85.D0) CALL GBOX(.5D0,0.D0,1.D0,1.D0,15,15) DO 20 I=0,9 X= .1*I+.05D0 DO 20 J=0,9 Y= .1*J+.05D0 CALL GMARK(X,Y,I,J) 20 CONTINUE CALL GWRITE(1,0.D0,1.D0, & 'Coloured markings, different shapes',1) CALL GINKEY('Press Q to quit, any other key to go on',CH) CALL GWINDO(0.D0,1.D0,0.D0,1.D0,0.D0,100.D0,0.D0,100.D0) CALL GBOX(0.D0,0.D0,1.D0,1.D0,0,2) RETURN END SUBROUTINE TEST5(CH) IMPLICIT REAL*8(A-H,O-Z) CHARACTER CH CALL GWINDO(-1.D0,1.D0,-1.D0,1.D0,15.D0,85.D0,15.D0,85.D0) DO 10 I=15,0,-1 X=0 R=.05D0*(I+1) CALL GCIRCL(X,X,R,I,I) 10 CONTINUE CALL GWRITE(1,0.D0,1.D0, & 'Coloured circles inside each other, different fill patterns',1) CALL GINKEY('Press Q to quit, any other key to go on',CH) CALL GWINDO(0.D0,1.D0,0.D0,1.D0,0.D0,100.D0,0.D0,100.D0) CALL GBOX(0.D0,0.D0,1.D0,1.D0,0,2) END SUBROUTINE TEST6(CH) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*72 TESTTX CHARACTER CH CALL GWINDO(0.d0,80.d0,0.d0,25.d0,0.D0,100.D0,0.D0,100.D0) do 10 i=0,24 WRITE(TESTTX,'(A9,I2,A1)') 'TEXT NR. ',i,'.' X=13*(I/5) Y=23-I+5*(I/5) CALL GWRITE(3,X,Y,TESTTX(1:16),I) 10 CONTINUE do 30 i=0,15 WRITE(TESTTX,'(16A1)') (CHAR(J),J=16*I,16*I+15) X=54 Y=16-I CALL GWRITE(3,X,Y,TESTTX(1:16),1) 30 CONTINUE CALL GWRITE(3,0.D0,24.D0,'Coloured text',1) CALL GINKEY('Press Q to quit, any other key to go on',CH) CALL GWINDO(0.D0,1.D0,0.D0,1.D0,0.D0,100.D0,0.D0,100.D0) CALL GBOX(0.D0,0.D0,1.D0,1.D0,0,2) END SUBROUTINE TEST7 * TESTROUTINE FOR GINPUT IMPLICIT REAL*8(A-H,O-Z) INTEGER STATUS CALL GWINDO(0.D0,100.D0,0.D0,100.D0,15.D0,85.D0,15.D0,85.D0) CALL GBOX (0.D0,0.D0,100.D0,100.D0,2,1) CALL GINPUT('Press ENTER to give starting point', & 50.D0,50.D0,X,Y,STATUS) CALL GMOVE(1,X,Y,3,1) 1 CONTINUE XALT=X YALT=Y 2 CONTINUE CALL GINPUT('Enter next point, press Q to quit', & XALT,YALT,X,Y,STATUS) IF (STATUS.NE.81.AND.STATUS.NE.113) THEN CALL GDRAW(1,X,Y) GOTO 1 END IF RETURN END SUBROUTINE TESTA * TESTROUTINE FOR GOPEN,GVALUE IMPLICIT REAL*8(A-H,O-Z) PARAMETER (XWMIN=15.D0,XWMAX=85.D0,YWMIN=15.D0,YWMAX=85.D0) CALL GOPEN(-1.D0,1.D0,-1.D0,0.D0,1.D0,-1.D0, & 'TEST GRAPH','Y=³X³**N',0,1) DO 10 J=1,6 CALL GCOLOR('Enter colour for next curve, A=STOP',ICOLOR) IF (ICOLOR.EQ.0) GOTO 20 CALL GMOVE(J,-1.D0,1.D0,ICOLOR,J) DO 10 I=-40,40 X=I/40.D0 Y=ABS(X)**J CALL GDRAW(J,X,Y) 10 CONTINUE 20 CALL GCLOSE RETURN END