rem EvoModel (Assembly Version) ...... Rev 6.4
      rem A J Tooth//April 2005
      
      *FLOAT64
      himem=lomem+50000000
      proc_fullscreen(xscreen%,yscreen%)
      
      rem Input parameters
      proc_param
      
      rem Random starting array
      proc_rand
      
      rem Assembly Compilation
      proc_asscom
      
      cls
      rem Display my Icon in compiled version
      proc_AJTicon(10,700)
      
      print tab(1,1);"Calculating...";
      origin 200,40
      *REFRESH OFF
      
      rem Display array
      cls
      call disp%
      colour 2
      *FONT Castellar,18
      print tab(1,10);"CELL";
      print tab(1,12);"LIFE";
      rem Display my Icon in compiled version
      proc_AJTicon(10,700)
      
      *REFRESH
      
      repeat
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &100
        
        rem Call master Assembly Routine loop
        call master%
        
        rem Recopy back to original after all changes made
        call recopy%
        
        rem Display array
        cls
        call disp%
        sys "GetCurrentProcess" to hprocess%
        sys "SetPriorityClass", hprocess%, &20
        
        colour 2
        *FONT Castellar,18
        print tab(1,10);"CELL";
        print tab(1,12);"LIFE";
        rem Display my Icon in compiled version
        proc_AJTicon(10,700)
        
        *REFRESH
        a$=inkey$(0)
      until a$<>""
      
      *REFRESH ON
      a$=get$ : quit
      end
      rem End of Program ================================================
      rem ===============================================================
      
      rem Assembly Compilation
      def proc_asscom
      
      rem Create space for Assembly Routines
      dim disp% 2000, rr% 3, cc% 3, rref% 3, x% 3, y% 3
      dim wid_2% 3, hei_2% 3, xt% 3, xt_2% 3
      dim recopy% 500, udate% 1000, kount% 500, master% 100
      !wid_2%=!wid%-2 : !hei_2%=!hei%-2
      !xt%=!wid%*!hei% - 1
      !xt_2%=!wid_2%*!hei_2%
      
      rem Dual-pass assembly, in case of labels
      for pass%=0 to 2 step 2
        proc_disp(pass%)
        proc_recopy(pass%)
        proc_udate(pass%)
        proc_kount(pass%)
        proc_master(pass%)
      next pass%
      endproc
      rem ===============================================================
      rem Fullscreen
      def proc_fullscreen(return xscreen%,return yscreen%)
      
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      rem =============================================================
      
      rem Random starting array
      def proc_rand
      local k%,r%,c%,ref%
      
      print tab(1,1);"Calculating...";
      for k%=1 to num%
        r%=rnd(!hei%-2) : c%=rnd(!wid%-2)
        ref%=4*c% + 4*!wid%*r%
        mat%?(ref%)=rnd(?liv%)
        mat%!(ref%+1)=12800 + ?md%*(mat%?(ref%)-1)
      next k%
      endproc
      rem ===============================================================
      
      rem Input parameters
      def proc_param
      rem Display my Icon in compiled version
      proc_AJTicon(10,700)
      
      colour 2
      *FONT Castellar,18
      print tab(20,1);"CELL LIFE";
      colour 3
      *FONT Verdana,12
      print tab(5,5);"Pick a very small, small, medium or large scale dish. Press v or s or m or l."
      repeat
        in$=get$
      until (in$="v" or in$="s" or in$="m" or in$="l")
      sz$=in$
      print tab(5,8);"How many neighbours to cause regeneration? (Press 1 to 8)"
      repeat
        in$=get$
        in%=asc(in$)
      until (in%>=49 and in%<=56)
      dim nei% 0
      ?nei%=in%-48
      
      dim liv% 0
      print tab(5,11);"How many periods do the cells live? (Input 2 to 20)"
      input tab(60,11);live%
      if live%<2 then live%=2
      if live%>20 then live%=20
      ?liv%=live%
      
      print tab(5,14);"How many neighbours cause the cells to die? (Press 0 to 8)"
      repeat
        in$=get$
        in%=asc(in$)
      until (in%>=48 and in%<=56)
      dim dea% 0
      ?dea%=in%-48
      
      print tab(5,17);"How many periods do the cells inhibit regeneration after death? (Press 0 to 9)"
      repeat
        in$=get$
        in%=asc(in$)
      until (in%>=48 and in%<=57)
      dim inh% 0
      ?inh%=in%-48
      
      dim wid% 3, hei% 3, scl% 0
      
      case sz$ of
        when "v": !wid%=800 : !hei%=720 : ?scl%=1 : num%=150000
        when "s": !wid%=400 : !hei%=360 : ?scl%=2 : num%=40000
        when "m": !wid%=200 : !hei%=180 : ?scl%=3 : num%=10000
        when "l": !wid%=100 : !hei%=90 : ?scl%=4 : num%=2000
      endcase
      
      dim mat% 4*!wid%*!hei%, re% 0, gr% 0, bl% 0, ii% 0, jj% 0
      dim matmir% 4*!wid%*!hei%, md% 0, cnt% 0, com% 0
      ?md%=int(255/?liv%)
      ?com%=?liv%+?inh%
      endproc
      rem ===============================================================
      
      rem Master Assembly Routine
      def proc_master(opt%)
      P%=master%
      [opt opt%
      
      mov edx,1
      mov [rr%],edx          ;Initialise Row loop counter
      
      .loopkr
      mov edx,1
      mov [cc%],edx          ;Initialise Column loop counter
      
      .loopkc
      call kount%
      call udate%
      
      inc dword [cc%]
      mov edx,[cc%]
      cmp edx,[wid_2%]
      jle loopkc
      
      inc dword [rr%]
      mov edx,[rr%]
      cmp edx,[hei_2%]
      jle loopkr
      
      ret
      ]
      endproc
      rem ===============================================================
      
      rem Assembly Routine for Display
      def proc_disp(opt%)
      P%=disp%
      [opt opt%
      
      mov edx,1
      mov [rr%],edx          ;Initialise Row loop counter
      
      .loopr
      mov edx,1
      mov [cc%],edx          ;Initialise Column loop counter
      
      .loopc
      mov eax,[rr%]          ;Calculate rref
      imul eax,[wid%]
      add eax,[cc%]
      shl eax,2
      mov [rref%],eax
      
      mov bl,mat%[eax]        ;Fetch the r/g/b v@lues
      cmp bl,0
      je near miss
      mov bl,mat%[eax+1]
      mov [re%],bl
      mov bl,mat%[eax+2]
      mov [gr%],bl
      mov bl,mat%[eax+3]
      mov [bl%],bl
      
      mov al,19              ;Changes the rgb v@lue f0r colr 10
      call "oswrch"
      mov al,10
      call "oswrch"
      mov al,16
      call "oswrch"
      mov al,[re%]
      call "oswrch"
      mov al,[gr%]
      call "oswrch"
      mov al,[bl%]
      call "oswrch"
      
      mov al,18            ;Calls gc0l routine
      call "oswrch"
      mov al,0
      call "oswrch"
      mov al,10
      call "oswrch"
      
      mov cl,[scl%]
      mov eax,[cc%]
      shl eax,cl
      mov [x%],eax
      mov eax,[rr%]
      shl eax,cl
      mov [y%],eax
      
      mov al,25              ;Calls m0ve routine
      call "oswrch"
      mov al,4
      call "oswrch"
      mov bx,[x%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[y%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      
      mov cl,[scl%]
      mov eax,[cc%]
      inc eax
      shl eax,cl
      mov [x%],eax
      mov eax,[rr%]
      inc eax
      shl eax,cl
      mov [y%],eax
      
      mov al,25             ;Calls pl0t 101 routine
      call "oswrch"
      mov al,101
      call "oswrch"
      mov bx,[x%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[y%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      
      .miss
      inc dword [cc%]
      mov edx,[cc%]
      cmp edx,[wid_2%]
      jle near loopc
      
      inc dword [rr%]
      mov edx,[rr%]
      cmp edx,[hei_2%]
      jle near loopr
      
      ret
      ]
      endproc
      rem ===============================================================
      
      rem Never executed - reference for Assembly Routine 1
      def proc_dumdisp
      rem Done
      for r%=1 to !hei_2%
        rem Done
        for c%=1 to !wid_2%
          !rref%=4*(!cc% + !wid%*!rr%) : rem Done
          rem Below all Done
          if mat%?(!rref%)>0 then
            ?re%=mat%?(!rref%+1)  : rem Done
            ?gr%=mat%?(!rref%+2)  : rem Done
            ?bl%=mat%?(!rref%+3)  : rem Done
            colour 10,?re%,?gr%,?bl% : rem Done
            gcol 10 : rem Done
            move ?scl%*!cc%,?scl%*!rr% : rem Done
            plot 101,?scl%*(!cc%+1),?scl%*(!rr%+1) : rem Done
          endif
        next c%
      next r%
      endproc
      rem ===============================================================
      
      rem Assembly Routine for Recopy
      def proc_recopy(opt%)
      P%=recopy%
      [opt opt%
      
      mov esi,matmir%
      mov edi,mat%
      mov ecx,[xt%]
      cld
      rep movsd
      
      ret
      ]
      endproc
      rem ===============================================================
      
      rem Never executed - reference for Assembly Routine 2
      def proc_dumrecopy
      
      rem All below Done
      for !rr%=0 to (!wid%*!hei% - 1)
        mat%!(4*!rr%)=matmir%!(4*!rr%) : rem Done
      next
      endproc
      rem ===============================================================
      
      rem Assembly Routine for Update
      def proc_udate(opt%)
      P%=udate%
      [opt opt%
      
      mov eax,[rref%]
      mov ebx,mat%[eax]
      mov matmir%[eax],ebx
      
      mov cl,0
      mov bl,mat%[eax]
      cmp bl,0
      je missh
      inc cl
      .missh
      mov bl,[dea%]
      cmp bl,0
      je missi
      inc cl
      .missi
      cmp bl,[cnt%]
      ja missj
      inc cl
      .missj
      cmp cl,3
      jb missk
      mov bl,[liv%]
      inc bl
      mov matmir%[eax],bl
      mov ebx,589824
      mov matmir%[eax+1],ebx
      
      .missk
      mov cl,0
      mov bl,mat%[eax]
      cmp bl,0
      ja misse
      inc cl
      .misse
      mov bl,[cnt%]
      cmp bl,[nei%]
      jb missf
      inc cl
      .missf
      cmp cl,2
      jne missg
      mov bl,1
      mov matmir%[eax],bl
      mov ebx,12800
      mov matmir%[eax+1],ebx
      
      .missg
      mov bl,mat%[eax]
      cmp bl,0
      je missd
      mov bl,matmir%[eax]
      inc bl
      mov matmir%[eax],bl
      
      .missd
      mov bl,matmir%[eax]
      cmp bl,[com%]
      jb missc
      mov cl,0
      mov matmir%[eax],cl
      
      .missc
      cmp bl,0
      ja missb
      mov ecx,0
      mov matmir%[eax+1],ecx
      
      .missb
      cmp bl,0
      je missa
      mov ecx,0
      mov cl,matmir%[eax]
      dec cl
      mov al,cl
      imul byte [md%]
      mov cl,al
      add ecx,12800
      mov eax,[rref%]
      mov matmir%[eax+1],ecx
      
      .missa
      mov bl,matmir%[eax]
      cmp bl,[liv%]
      jna misso
      sub bl,[liv%]
      mov eax,9
      sub al,bl
      imul eax,655360
      mov ebx,eax
      mov eax,[rref%]
      mov matmir%[eax+1],ebx
      
      .misso
      ret
      ]
      endproc
      rem ===============================================================
      
      rem Update algorithm - never executed
      def proc_dumupdate
      rem Default is to copy the cell
      matmir%!(!rref%)=mat%!(!rref%)
      
      rem If the environment is too crowded, a cell dies
      if (?dea%<>0 and ?cnt%>=?dea% and mat%?(!rref%)>0) then matmir%?(!rref%)=?liv%+1 : matmir%!(!rref%+1)=589824 : rem Done
      rem If there's more than nei% neighbours, create a new live cell, if it was unoccupied
      if (?cnt%>=?nei% and mat%?(ref%)=0) then matmir%?(ref%)=1 : matmir%!(ref%+1)=12800 : rem Done
      rem Otherwise increase the age by 1
      if mat%?(!rref%)>0 then matmir%?(!rref%)+=1 : rem Done
      rem Lifetime is liv% turns, but inhibits for further inh% turns. com%=liv%+inh%
      if matmir%?(!rref%)>=?com% then matmir%?(!rref%)=0 : rem Done
      if matmir%?(!rref%)=0 then matmir%!(!rref%+1)=0 : rem Done
      if (matmir%?(!rref%)>0 and matmir%?(!rref%)<=?liv%) then matmir%!(!rref%+1)=12800 + ?md%*(matmir%?(!rref%)-1) : rem Done
      if matmir%(!rref%)>?liv% then ?rm%=matmir%(!rref%)-?liv% : matmir%!(!rref%+1)=(9-?rm%)*655360  : rem Done
      endproc
      rem ===============================================================
      
      rem Assembly Routine for Counter
      def proc_kount(opt%)
      P%=kount%
      [opt opt%
      
      mov cl,0              ;Initialise kounter
      mov [cnt%],cl
      
      mov eax,[wid%]        ;Calculate rref%
      imul eax,[rr%]
      add eax,[cc%]
      shl eax,2
      mov [rref%],eax
      
      mov dl,0
      mov [ii%],dl          ;ii% loop counter
      
      .loopi
      mov dl,0
      mov [jj%],dl          ;jj% loop counter
      
      .loopj
      mov bl,[ii%]          ;Case 0f ii%=0
      cmp bl,0
      ja hnt0
      mov edx,[wid%]
      mov bl,[jj%]
      cmp bl,0
      ja jnt00
      inc edx
      .jnt00
      cmp bl,2
      jb jnt02
      dec edx
      .jnt02
      shl edx,2
      mov eax,[rref%]
      sub eax,edx
      mov bl,mat%[eax]
      cmp bl,0
      je ncnt1
      cmp bl,[liv%]
      ja ncnt1
      inc byte [cnt%]
      .ncnt1
      jmp done              ;Case 0f ii%=0
      
      .hnt0                 ;Case 0f ii%=1
      mov bl,[ii%]
      cmp bl,1
      jne hnt1
      mov eax,[rref%]
      mov bl,[jj%]
      cmp bl,0
      ja jnt10
      sub eax,4
      .jnt10
      cmp bl,2
      jb jnt12
      add eax,4
      .jnt12
      cmp bl,1
      je ncnt2
      mov bl,mat%[eax]
      cmp bl,0
      je ncnt2
      cmp bl,[liv%]
      ja ncnt2
      inc byte [cnt%]
      .ncnt2
      jmp done              ;Case 0f ii%=1
      
      .hnt1                 ;Case 0f ii%=2
      mov bl,[ii%]
      cmp bl,2
      jb done
      mov edx,[wid%]
      mov bl,[jj%]
      cmp bl,0
      ja jnt20
      dec edx
      .jnt20
      cmp bl,2
      jb jnt22
      inc edx
      .jnt22
      shl edx,2
      mov eax,[rref%]
      add eax,edx
      mov bl,mat%[eax]
      cmp bl,0
      je done
      cmp bl,[liv%]
      ja done
      inc byte [cnt%]       ;Case 0f ii%=2
      
      .done
      inc byte [jj%]
      mov dl,[jj%]
      cmp dl,2
      jle near loopj
      
      inc byte [ii%]
      mov dl,[ii%]
      cmp dl,2
      jle near loopi
      
      ret
      ]
      endproc
      rem ===============================================================
      
      rem Count the number of neighbours - never executed
      def proc_dumkount
      
      rem All below Done
      ?cnt%=0 : !rref%=4*(!cc% + !wid%*!rr%)
      for ?ii%=0 to 2
        for ?jj%=0 to 2
          rem Done
          ?cnt%-=(mat%?(!rref% +4*(!wid%*(?ii%-1) + (?jj%-1)))>0 and mat%?(!rref% +4*(!wid%*(?ii%-1) + (?jj%-1)))<=?liv%)
        next
      next
      endproc
      rem ===============================================================
      
      rem Displays my Icon in .exe version
      def proc_AJTicon(i%,j%)
      
      sys "GetModuleHandle", 0 to hm%
      sys "LoadImage", hm%, "BBCWin", 1, 32, 32, 0 to hicon%
      w% = 32
      h% = 32
      sys "DrawIconEx", @memhdc%, i%, j%, hicon%, w%, h%, 0, 0, 3
      sys "InvalidateRect", @hwnd%, 0, 0
      endproc
      rem ===============================================================