home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / fortran77_210 / library / f77 / tcircles < prev    next >
Encoding:
Text File  |  1991-11-16  |  1.6 KB  |  56 lines
  1. C >TCIRCLES a Fortran77 version of the BASIC V program Tcircles
  2. C K.M.CRENNELL             16 November 1991
  3.       INTEGER  GetMod
  4.       M=0
  5. C                          M is MODE
  6.    50 CALL MODE (M )
  7.       CALL Getcls(M,K)
  8.       CALL TAB(0,0) 
  9.       PRINT *,' Mode ',M,' has ',K,' colours'
  10.       IH=1020
  11.       Marg=32
  12.       ID=32
  13. C set the radius depending on no of colours K, ID is distance between circles
  14.       IR=0.5*(IH-2*Marg-ID*(K-1))/K
  15.       IX=Marg
  16.       IY=IH/2
  17.       IDX=2*IR+ID
  18.       DO 60 N=1, K, 1
  19.       CALL GCOL(0,N)
  20. C   set the colour ignore zero because it is black
  21. C      MOVE IX+IR,IY        these are the calls for drawing circles
  22. C      PLOT153,IR,0          on the BBC Master
  23.       CALL CIRCLE(IX+IR,IY,IR,.TRUE.)
  24.       IX=IX+IDX
  25.    60 CONTINUE
  26.       M=GetMod()
  27.       CALL CLS
  28.       IF (M.GE.0) GOTO 50
  29.       STOP
  30.       END
  31.       SUBROUTINEGetcls(M,K)
  32. C                          find out the number of colours K for Mode M
  33.       DIMENSION KOLS(0:2)
  34. C                          storage for number of colours for each mode used
  35.       K=2
  36.       KOLS(0)=1
  37.       KOLS(1)=3
  38.       KOLS(2)=7
  39. C                      should be 16 but 8 are flashing and 0 not included
  40.       IF (M.LT.0 .OR. M.GT.2 )THEN 
  41.         K=-1 
  42.       ELSE
  43.         K=KOLS(M)
  44.       ENDIF
  45.       RETURN
  46.       END           
  47.       INTEGER FUNCTION GetMod()
  48. C                     function to ask for another MODE
  49.   330 PRINT*,' Enter next Mode.  0=< Mode <3  or - to stop'
  50.       IA=IGET()
  51. C                   accept only expected numbers or -
  52.        IF (INDEX('-012',CHAR(IA)).EQ.0) GOTO330
  53.       GetMod=IA-48
  54.       RETURN
  55.       END
  56.