home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / e / mailinglists / binaries / map.lha / map.e
Text File  |  1993-08-10  |  4KB  |  175 lines
  1. /*
  2.     MapGenerator 1.0 was written by Kai.Nikulainen@utu.fi.  Any comments
  3.    are welcome. (Except the negative ones concerning my programming-style:)
  4. */
  5.  
  6. MODULE 'intuition/intuition'
  7.  
  8. CONST HEI=128,WID=128,BUFSIZE=3*GADGETSIZE
  9.  
  10. /* These are minimum and maximum values that can be in the map-array.
  11.    If you change MIN<0 or MAX>15, you must change the draw-procedure,
  12.    because it uses the map-array's values as color numbers
  13. */
  14. CONST MINI=0,MAXI=15
  15.  
  16. ENUM QUIT,SMOOTH,START
  17.  
  18. DEF map,s,w,steps,buf[BUFSIZE]:ARRAY
  19.  
  20. PROC openAll()
  21. DEF next
  22.   map:=New((HEI+1)*(WID+1))  /* This is a bit too big, just to be sure */
  23.   next:=Gadget(buf,NIL,START,0,20,186,80,'New map')
  24.   next:=Gadget(next,buf,SMOOTH,0,120,186,80,'Smooth')
  25.   next:=Gadget(next,buf,QUIT,0,220,186,80,'Quit')
  26.   s:=OpenS(320,200,4,0,' MapGenerator 1.0')
  27.   w:=OpenW(0,0,320,200,IDCMP_GADGETUP,WFLG_BACKDROP+WFLG_BORDERLESS,'',s,15,buf)
  28.   LoadRGB4(ViewPortAddress(w),[$03b,$cb9,$b97,$8a3,$792,$681,$571,$460,$450,
  29.            $540,$430,$410,$400,$666,$999,$ccc]:INT,16)
  30. ENDPROC
  31.  
  32. PROC init()
  33. DEF i
  34.   msg('Initializing')
  35.   /* You might want to change VbeamPos to some other function that has more
  36.      possible values */
  37.   Rnd(-VbeamPos())
  38.   FOR i:=0 TO (1+HEI)*(WID+1)-1 DO map[i]:=8
  39. ENDPROC
  40.  
  41. PROC end()
  42.   CloseW(w)
  43.   CloseS(s)
  44.   CleanUp(0)
  45. ENDPROC
  46.  
  47. PROC msg(s)
  48.   Box(0,153,310,165,0)
  49.   Colour(1,0)
  50.   TextF(120,160,'\s',s)
  51. ENDPROC
  52.  
  53.  
  54. /*  Smooth calculates the average of 5 pixels and uses that as a new value. 
  55.     You might want smooth a map several times to get more lakes and rivers or
  56.     to lower the mountains. */
  57. PROC smooth()
  58. DEF i,j,s
  59.   msg('Smoothing..')
  60.   FOR i:=1 TO WID-2
  61.     FOR j:=1 TO HEI-2
  62.       s:=i*WID+j
  63.       map[s]:=(map[s-1]+map[s+1]+map[s-HEI]+map[s+HEI]+map[s]+2)/5
  64.       IF map[s]>MAXI THEN map[s]:=MAXI
  65.     ENDFOR
  66.   ENDFOR
  67.   FOR i:=1 TO WID-2
  68.     map[i*WID]:=map[i*WID+1]
  69.     map[i*WID+HEI-1]:=map[i*WID+HEI-2]
  70.   ENDFOR
  71.   FOR i:=0 TO HEI-1
  72.     map[i]:=map[i+WID]
  73.     map[WID*(WID-1)+i]:=map[WID*(WID-2)+i]
  74.   ENDFOR
  75. ENDPROC
  76.  
  77. /* change divides the map in small equally sized squares.  Inside a square
  78.    to each value d is added.  d is -1,0 or 1. */
  79. PROC change()
  80. DEF dx,dy,i,j,x,y=0,a,b,d,k
  81.   msg('Creating...')
  82.   dx:=WID/steps
  83.   dy:=HEI/steps
  84.   IF dx<1 THEN dx:=1
  85.   IF dy<1 THEN dy:=1
  86.   FOR i:=1 TO steps
  87.     x:=0
  88.     FOR j:=1 TO steps
  89.       d:=Rnd(3)-1
  90.       FOR a:=x TO x+dx-1
  91.         FOR b:=y TO y+dy-1
  92.           k:=map[a*WID+b]+d
  93.       IF And(k>=MINI,k<=MAXI) THEN map[a*WID+b]:=k
  94.     ENDFOR
  95.       ENDFOR
  96.       x:=x+dx
  97.     ENDFOR
  98.     y:=y+dy
  99.   ENDFOR
  100.   steps:=steps*2
  101. ENDPROC
  102.  
  103. /* change2 uses larger squares than change and the squares are placed randomly.
  104.    This means they can be partially overlapping.  The value of d is between 
  105.    -steps/2 and steps/2. */
  106. PROC change2()
  107. DEF x,y,i,j,d,c,a
  108.   msg('Creating...')
  109.   /* changing the following multiplyer  also changes the maps quite a lot */
  110.   FOR c:=1 TO steps*3
  111.     x:=Rnd(WID)
  112.     y:=Rnd(HEI)
  113.     d:=Rnd(steps+1)-(steps/2)
  114.     FOR i:=x-(WID/steps) TO x+(WID/steps)
  115.       FOR j:=y-(HEI/steps) TO y+(HEI/steps)
  116.         IF And(And(i>=MINI,j>=MINI),And(i<WID,j<HEI)) 
  117.           a:=map[i*WID+j]+d
  118.       IF And(a>=MINI,a<=MAXI) THEN map[i*WID+j]:=a
  119.         ENDIF
  120.       ENDFOR
  121.     ENDFOR
  122.   ENDFOR
  123.   steps:=steps*2
  124. ENDPROC
  125.  
  126.  
  127. PROC draw()
  128. DEF i,j
  129.   msg('Plotting...')
  130.   FOR i:=0 TO WID-1
  131.     FOR j:=0 TO HEI-1
  132.       Plot(i+96,j+15,map[i*WID+j])
  133.     ENDFOR
  134.   ENDFOR
  135. ENDPROC
  136.  
  137.  
  138. PROC main()
  139. DEF i,class=NIL,adr:PTR TO gadget,usrdat
  140.   openAll()
  141.   REPEAT
  142.     init()
  143.     steps:=2
  144.     FOR i:=1 TO 7
  145.       /* Change the bordervalue and the maps may change a lot */
  146.       IF i<3 THEN change2() ELSE change()
  147.       draw()
  148.     ENDFOR
  149.     REPEAT
  150.       msg('What next?')
  151.       WHILE class=NIL
  152.         class:=WaitIMessage(w)
  153.         adr:=MsgIaddr()
  154.         SELECT class
  155.           CASE IDCMP_GADGETUP
  156.             usrdat:=adr.userdata
  157.           DEFAULT
  158.             class:=NIL
  159.         ENDSELECT
  160.       ENDWHILE
  161.       SELECT usrdat
  162.         CASE SMOOTH
  163.           smooth()
  164.       draw()
  165.     CASE START
  166.     CASE QUIT
  167.     DEFAULT
  168.       usrdat:=666
  169.       ENDSELECT
  170.       class:=NIL
  171.     UNTIL Or(usrdat=QUIT,usrdat=START)
  172.   UNTIL usrdat=QUIT
  173.   end()
  174. ENDPROC
  175.