PARAMETER(KRED = 13, KGREEN = 14, KBLUE = 16, KWHITE = 19) PARAMETER(LSOLID = 1, MCOPYPEN = 4, NOTXORPEN = 11) DIMENSION NB(24) CHARACTER ch DATA MX/NOTXORPEN/ DATA NBC,MS/1,40/ WRITE(*,'(A,$)') + 'Select Ball [1 = BMP file, 2 = Mark, 3 = Symbol] : ' READ(*,*) IBALL CALL GWOPEN(ID,0) * CALL GWMODE(IR, 2, 1) CALL GWSIZE(IR, 5, LLW, LLH) CALL GWSIZE(IR,-1, LLW, LLH) WX = LLW-1 WY = LLH-1 CALL GWINDOW(IR,0.0,0.0,0.0,0.0) CALL GWVWMOD(IR,1) CALL GWSETPEN(IR,KGREEN,LSOLID,0,MCOPYPEN) CALL GWRECT(IR,0.0,0.0,WX,WY) DO i = 1, 9 CALL GWLINE(IR,WX/10*i,0.0,WX/10*i,WY) ENDDO DO i = 1, 9 CALL GWLINE(IR,0.0,WY/10*i,WX,Wy/10*i) ENDDO IF(IBALL.EQ.1) THEN CALL GWLOADBMP(NB(1), 0, 'jonathan1.bmp') CALL GWSETBMP(IR,NB(1),0.0,0.0,-1,-1,-1) CALL GWGETBMP(IR, NB(1), W, H, IW, IH, IB, MAXNB, ' ') CALL GWLOADBMP(NB(2), 0, 'jonathan2.bmp') CALL GWSETBMP(IR,NB(2),0.0,0.0,-1,-1,-1) W = IW/2.0 H = IH/2.0 ELSE IF(IBALL.EQ.2) THEN W = WY/40 H = WY/40 CALL GWSETPEN(IR,KWHITE,-1,-1,MX) CALL GWSETMRK(IR,6,2*H,KBLUE,-1,MX) ELSE CALL GWSETTXT(IR,WY/10,0.0,-1,KBLUE,-1,'WingDings') ch(1:1) = char(182) W = 0 H = 0 DO N = 1, 24 CALL GWSETTXT(IR,-1.0,15.0*(N-1)/360.0,-1,-1,-1,' ') CALL GWgettxt(IR, ww, hh, xx, yy, ch) IF(ww .GT. W) W = ww IF(hh .GT. H) H = hh CALL GWldcsiz(IR, ww, hh, iw, ih) CALL GWldcsiz(IR, xx, yy, iu, iv) CALL GWFNT2BMP(NB(N), 0, iw, ih, iu, iv, ch) IF(NB(N) .LE. 0) THEN CALL GWQUIT(IR) STOP ENDIF CALL GWSETBMP(IR,NB(N),0.0,0.0,-1,-1,-1) ENDDO W = W/2 H = H/2 ENDIF CALL GWANCHOR(IR, 1) ! cast anchor C C Set initial position/velocity by mouse C CALL GWCAPLIN(IR,X,Y,XE,YE,'Drag mouse') IF(IBALL.EQ.1 .AND. XE.LT.X) NBC = 2 dX = MS*(XE-X)/5000 dY = MS*(YE-Y)/5000 WRITE(*,'(A,F5.2)') 'Speed = ',SQRT(dX*dX+dY*dY)/W/MS*100 C ILBTN = 0 CALL GWKYBRD(IVK, ICH, NCH, IFL, -1) DO WHILE(ILBTN.EQ.0.OR.IVK.NE.0) XL = X YL = Y IF(X + dX.GT.WX-W) THEN IF(IBALL.EQ.1) THEN NBC = 2 ENDIF dX = -dX X = WX-W ELSE IF(X + dX.LT.W) THEN IF(IBALL.EQ.1) THEN NBC = 1 ENDIF dX = -dX X = W ELSE X = X + dX ENDIF IF(Y + dY.GT.WY-H) THEN dY = -dY Y = WY-H ELSE IF(Y + dY.LT.H) THEN dY = -dY Y = H ELSE Y = Y + dY ENDIF CALL GWMOUSE(ILBTN,IRBTN,XM,YM) CALL GWKYBRD(IVK, ICH, NCH, IFL, -1) CALL GWSETOGN(IR,0,-1) ! deferred drawings IF(IBALL.EQ.1) THEN CALL GWPUTBMP(IR,NB(NBC),X,Y,-1) ELSE IF(IBALL.EQ.2) THEN CALL GWPUTMRK(IR,X,Y) ELSE NBC = MOD(NBC, 24) + 1 CALL GWPUTBMP(IR,NB(NBC),X,Y,-1) ENDIF CALL GWSLEEP(IR,MS) CALL GWFLUSH(IR,-1) ENDDO CALL GWQUIT(IR) END