DataMuseum.dk

top - metrics - download

    Length: 3458 (0xd82)
    Types: TextFile
    Names: »gen.f«

└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
    └─⟦this⟧ »EUUGD18/General/Empire/gen.f« 

TextFile

C
C RANDOM MAP GENERATION SUBROUTINES
C
	SUBROUTINE GEN
	IMPLICIT INTEGER(A-Z)
	PARAMETER (WIDTH=100,HEIGHT=60)
	character MAP(WIDTH,HEIGHT)
	character OWNED(WIDTH,HEIGHT)
	INTEGER SIZES(128)

	include 'common.h'

	EQUIVALENCE (MAP(1,1),OMAP(1)),(OWNED(1,1),RMAP(1))

100	DO 200 I=1,WIDTH
	DO 200 J=1,HEIGHT
200	MAP(I,J)='.'

	HSECTS=3+irand(4)
	VSECTS=3+irand(3)

	HSPACE=WIDTH/HSECTS
	VSPACE=HEIGHT/VSECTS
	DO 400 I=1,HSECTS
	  DO 400 J=1,VSECTS
	    DO 400 K=1,irand(2)+irand(3)
	        CALL MAKELAND
	        YPOS=(J-1)*VSPACE+irand(VSPACE)
	        XPOS=(I-1)*HSPACE+irand(HSPACE)
	  	DO 300 L=1,39
		  DO 300 M=1,39
		    IF (SUBMAP(L,M).EQ.' ') GOTO 300
		    IF (((XPOS+L-20).LE.0).OR.((XPOS+L-20).GT.100)) GOTO 300
		    IF (((YPOS+M-20).LE.0).OR.((YPOS+M-20).GT.60)) GOTO 300
		    MAP(XPOS+L-20,YPOS+M-20)=SUBMAP(L,M)
300		CONTINUE
400	CONTINUE
	COUNT=0
	DO 500 I=1,100
	DO 500 J=1,60
	IF (MAP(I,J).EQ.'.') COUNT=COUNT+1
500	CONTINUE

	IF (COUNT.LT.4000.AND.COUNT.GT.2500) GOTO 600
c	PRINT 999,COUNT
C	WRITE (1,999) COUNT
c999	FORMAT(' FAILED SEA CHECK, COUNT=',I5)
	GOTO 100

c600	PRINT 998,COUNT
C	WRITE (1,998) COUNT
c998	FORMAT(' COUNT=',I5)
600	continue

 	DO 800 I=1,100
	DO 800 J=1,60
	OWNED(I,J)='\0'
800	CONTINUE
	LAREA=1
	WAREA=33
	DO 1000 I=2,99
	DO 1000 J=2,59
	IF (OWNED(I,J).NE.'\0') GOTO 1000
	 IF (MAP(I,J).EQ.'.') THEN
	   IF (SET(I,J,CHAR(WAREA),'.',12000).EQ.0) GOTO 100
	   WAREA=WAREA+1
	   GOTO 1000
	  ELSE
	   IF (SET(I,J,CHAR(LAREA),'+',1200).EQ.1) GOTO 900
c	   PRINT 997
C	   WRITE (1,997)
c997	   FORMAT(' FAILED SINGLE LAND MASS TEST')
C	   GOTO 100
	goto 1000
	 ENDIF
900	LAREA=LAREA+1
1000	CONTINUE

	IF (LAREA.GE.10.AND.LAREA.LE.30) GOTO 1100
c	PRINT 996, LAREA
C	WRITE(1,996)
c996	FORMAT('FAILED SEPARATION TEST -- land areas = ', i4)
c	PRINT 103,((MAP(I,J),I=1,100),J=1,60)
C	WRITE(1,103) ((MAP(I,J),I=1,100),J=1,60)
c103	FORMAT(1X,100A1)
	GOTO 100

c1100	PRINT 995,((int('@')+int(OWNED(I,J)),I=1,100),J=1,60)
C	WRITE(1,995) (('@'+OWNED(I,J),I=1,100),J=1,60)
c995	FORMAT(1X,100A1)

1100	DO 1300 I=1,128
1300	SIZES(I)=0

	DO 1400 I=2,99
	DO 1400 J=2,59
	SIZES(int(OWNED(I,J)))=SIZES(int(OWNED(I,J)))+1
1400	CONTINUE

	SCOUNT=COUNT*40/50
	DO 1500 SEA=33,WAREA
1500	IF (SIZES(SEA).GE.SCOUNT) GOTO 1600
c	PRINT 994
C	WRITE (1,994)
c994	FORMAT(' FAILURE- OCEANS ARE SEPARATED')
	GOTO 100

1600	CITS=(6000-COUNT)/50+1
	CITS=MAX(52,CITS)
	CITS=MIN(70,CITS)
	SEACITS=CITS*60/100+irand(12)
	LANDCITS=CITS-SEACITS
	DO 2100 K=1,SEACITS
1700	I=irand(98)+2
	J=irand(58)+2
	IF (MAP(I,J).NE.'+') GOTO 1700
	DO 1800 L=MAX(2,I-1),MIN(99,I+1)
	DO 1800 M=MAX(2,J-1),MIN(59,J+1)
	IF (int(OWNED(L,M)).EQ.SEA) GOTO 1900
1800	CONTINUE
	GOTO 1700
1900	DO 2000 L=MAX(2,I-3),MIN(99,I+3)
	DO 2000 M=MAX(2,J-3),MIN(59,J+3)
	IF (OWNED(L,M).NE.OWNED(I,J)) GOTO 2000
	IF (MAP(L,M).EQ.'*') GOTO 1700
2000	CONTINUE
	MAP(I,J)='*'
	CITIES(int(OWNED(I,J)))=CITIES(int(OWNED(I,J)))+100
2100	CONTINUE

	DO 2500 K=1,LANDCITS
2200	I=irand(98)+2
	J=irand(58)+2
	IF (MAP(I,J).NE.'+') GOTO 2200
	DO 2300 L=MAX(2,I-1),MIN(99,I+1)
	DO 2300 M=MAX(2,J-1),MIN(59,J+1)
	IF (MAP(L,M).EQ.'.') GOTO 2200
2300	CONTINUE
	DO 2400 L=MAX(2,I-2),MIN(99,I+2)
	DO 2400 M=MAX(2,J-2),MIN(59,J+2)
	IF (OWNED(L,M).NE.OWNED(I,J)) GOTO 2400
	IF (MAP(L,M).EQ.'*') GOTO 2200
2400	CONTINUE
	MAP(I,J)='*'
	CITIES(int(OWNED(I,J)))=CITIES(int(OWNED(I,J)))+1
2500	CONTINUE

c	PRINT 993,((MAP(I,J),I=1,100),J=1,60)
C	WRITE(1,993) ((MAP(I,J),I=1,100),J=1,60)
c993	FORMAT(1X,100A1)

	END