home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Gfx / nice.e < prev    next >
Encoding:
Text File  |  1994-11-09  |  4.9 KB  |  197 lines
  1. /* Evolutionary "nice" pictures.
  2.  
  3.    breed bitmaps. A fitness function will assign numbers according to
  4.    all sorts of perception criteria. mutation, the usual.
  5.  
  6. possible "niceness" criteria:
  7. - amount of surrounding pixels having a similar color -> smoothness
  8. - amount of different colors used in total -> diversity
  9. - longer stretching lines (hard to detect)
  10. - symmetry / repetition / parallelism
  11. - find longest path (fill-alg)
  12.  
  13. */
  14.  
  15. OPT OSVERSION=37, PREPROCESS, REG=5
  16.  
  17. -> fixed parameters
  18.  
  19. DEF bmx=10,bmy=30,        -> bitmap size
  20.     bmnum=3,            -> #of bitmaps to breed at once
  21.     evrate=2,            -> kill/birth rate of evolution. <bmnum
  22.     nummut=1,            -> number of mutations each time
  23.     numrate=100            -> how many to rate
  24.  
  25. #define MIRROR
  26.  
  27. DEF bmt,            -> total bytes per bitmap
  28.     hinum=0,            -> best sofar
  29.     bmp=NIL:PTR TO LONG,
  30.     bmscore=NIL:PTR TO LONG,
  31.     bmcalc=NIL:PTR TO CHAR
  32.  
  33. MODULE 'tools/easygui', 'tools/exceptions', 'tools/clonescreen',
  34.        'intuition/screens'
  35.  
  36. DEF scr=NIL:PTR TO screen,font
  37.  
  38. DEF fmt,keepshowing=TRUE,iterations
  39.  
  40. PROC main() HANDLE
  41.   DEF r
  42.   fmt:='%2ld'
  43.   LOOP
  44.     r:=easygui('Nice Pix',
  45.       [EQROWS,
  46.         [SLIDE,{setbmx},'bitmap x size:    ',FALSE,3,99,bmx,10,fmt],
  47.         [SLIDE,{setbmy},'bitmap y size:    ',FALSE,3,99,bmy,10,fmt],
  48.         [SLIDE,{setbmn},'#of bitmaps:    ',FALSE,2,99,bmnum,10,fmt],
  49.         [SLIDE,{setevr},'kill/birth:    ',FALSE,1,99,evrate,10,fmt],
  50.         [SLIDE,{setmut},'mutations:      ',FALSE,1,99,nummut,10,fmt],
  51.         [SLIDE,{setrat},'rating:      ',FALSE,1,999,numrate,10,fmt],
  52.         [BAR],
  53.         [COLS,[BUTTON,1,'Start'],[SPACEH],[BUTTON,0,'Cancel']]
  54.       ]
  55.     )
  56.     evrate:=Bounds(evrate,1,bmnum-1)
  57.     IF r=0 THEN Raise()
  58.     actionreq()
  59.   ENDLOOP
  60. EXCEPT
  61.   IF scr THEN closeclonescreen(scr,font)
  62.   report_exception()
  63. ENDPROC
  64.  
  65. PROC setbmx(i,n) IS bmx:=n
  66. PROC setbmy(i,n) IS bmy:=n
  67. PROC setbmn(i,n) IS bmnum:=n
  68. PROC setevr(i,n) IS evrate:=n
  69. PROC setmut(i,n) IS nummut:=n
  70. PROC setrat(i,n) IS numrate:=n
  71.  
  72. PROC actionreq() HANDLE
  73.   DEF gh=NIL:PTR TO guihandle,res=-1,count=0,a
  74.   gh:=guiinit('Nice Pix Action: BUSY',
  75.     [EQROWS,
  76.       [CHECK,{togglekeep},'keep showing picture:',keepshowing,TRUE],
  77.       [SLIDE,{setw1},'weight:    ',FALSE,0,99,50,10,fmt],
  78.       [BAR],
  79.       [COLS,[BUTTON,{showpic},'Show Picture'],[SPACEH],[BUTTON,0,'Stop']]
  80.     ]
  81.   )
  82.   setupsim()
  83.   IF scr THEN SetRast(scr.rastport,0)
  84.   WHILE res<0
  85.     ->Wait(gh.sig)
  86.     res:=guimessage(gh)
  87.     FOR a:=1 TO 3 DO dosim()
  88.     IF keepshowing THEN IF count++ AND $F = 0 THEN showpic(0)
  89.   ENDWHILE
  90. EXCEPT DO
  91.   deallocsim()
  92.   cleangui(gh)
  93.   IF exception THEN ReThrow()
  94. ENDPROC res
  95.  
  96. PROC setw1(i,n) IS n
  97. PROC togglekeep(i,n) IS keepshowing:=n
  98.  
  99. CONST XO=40,YO=40,XZ=2,YZ=2,COL=16,DEPTH=4
  100. CONST XO1=XO+XZ-1,YO1=YO+YZ-1,XZ2=XZ*2,YZ2=YZ*2
  101.  
  102. PROC showpic(i)
  103.   DEF x,y,bm
  104.   bm:=bmp[hinum]
  105.   IF scr=NIL
  106.     scr,font:=openclonescreen('Workbench','Nice!',DEPTH)
  107.   ENDIF
  108.   SetStdRast(scr.rastport)
  109.   Colour(2,0)
  110.   TextF(XO,YO-10,'hi = \d, it = \d       ',bmscore[hinum],iterations)
  111.   FOR y:=YZ TO bmy*YZ STEP YZ
  112.     FOR x:=XZ TO bmx*XZ STEP XZ
  113.       #ifdef MIRROR
  114.         Box(bmx*XZ2-x+XO,y+YO,bmx*XZ2-x+XO1,y+YO1,bm[])
  115.         Box(bmx*XZ2-x+XO,bmy*YZ2-y+YO,bmx*XZ2-x+XO1,bmy*YZ2-y+YO1,bm[])
  116.         Box(x+XO,bmy*YZ2-y+YO,x+XO1,bmy*YZ2-y+YO1,bm[])
  117.       #endif
  118.       Box(x+XO,y+YO,x+XO1,y+YO1,bm[]++)
  119.     ENDFOR
  120.   ENDFOR
  121. ENDPROC
  122.  
  123. PROC setupsim()
  124.   DEF a,bm,b
  125.   bmt:=bmx*bmy
  126.   hinum:=0
  127.   iterations:=0
  128.   NEW bmp[bmnum]
  129.   NEW bmcalc[bmnum]
  130.   NEW bmscore[bmnum]
  131.   FOR a:=0 TO bmnum-1
  132.     bmp[a]:=bm:=FastNew(bmt)
  133.     FOR b:=0 TO bmt-1 DO bm[]++:=Rnd(COL)
  134.   ENDFOR
  135. ENDPROC
  136.  
  137. PROC deallocsim()
  138.   DEF a
  139.   IF bmp THEN FOR a:=0 TO bmnum-1 DO IF bmp[a] THEN FastDispose(bmp[a],bmt)
  140.   END bmp[bmnum]
  141.   END bmcalc[bmnum]
  142.   END bmscore[bmnum]
  143. ENDPROC
  144.  
  145. CONST MINSTART=$7FFFFFFF
  146.  
  147. PROC dosim()
  148.   DEF a,b,min,minnum
  149.   iterations++
  150.   FOR a:=0 TO bmnum-1                        -> make sure all are rated
  151.     IF bmcalc[a]=FALSE
  152.       mutate(bmp[a])
  153.       bmscore[a]:=rate(bmp[a])                    -> mutate and rerate if necessary
  154.       IF bmscore[a]>bmscore[hinum] THEN hinum:=a        -> keep track of best
  155.       bmcalc[a]:=TRUE
  156.     ENDIF
  157.   ENDFOR
  158.   FOR a:=1 TO evrate                        -> pick n victims
  159.     min:=MINSTART
  160.     FOR b:=0 TO bmnum-1
  161.       IF (bmcalc[b]) AND b<>hinum
  162.         IF bmscore[b]<min                    -> calc worst
  163.           min:=bmscore[b]
  164.           minnum:=b
  165.         ENDIF
  166.       ENDIF
  167.     ENDFOR
  168.     IF min=MINSTART THEN Raise("prob")
  169.     bmcalc[minnum]:=FALSE
  170.     CopyMem(bmp[hinum],bmp[minnum],bmt)                -> copy from best
  171.   ENDFOR
  172. ENDPROC
  173.  
  174. PROC mutate(bm)
  175.   DEF a
  176.   FOR a:=1 TO nummut DO bm[Rnd(bmt)]:=Rnd(COL)
  177. ENDPROC
  178.  
  179. PROC rate(bma)                            -> B: mixed environ
  180.   DEF a,c=0,tc,nc,bm
  181.   bm:=bma
  182.   FOR a:=0 TO bmt-1
  183.     tc:=bm[]
  184.     nc:=0
  185.     IF bm[-1]=tc THEN nc++
  186.     IF bm[1]=tc THEN nc++
  187.     IF bm[bmx]=tc THEN nc++
  188.     IF bm[bmx-1]=tc THEN nc++
  189.     IF bm[bmx+1]=tc THEN nc++
  190.     IF bm[-bmx]=tc THEN nc++
  191.     IF bm[-bmx-1]=tc THEN nc++
  192.     IF bm[-bmx+1]=tc THEN nc++
  193.     c:=c+(6-Abs(nc-2))
  194.     bm++
  195.   ENDFOR
  196. ENDPROC c
  197.