rem Worrying Sheep .... Rev 1.2
      rem A J Tooth // March 2004
      rem Revised 30th December 2006
      on error if (err=17) then quit
      
      rem Setup
      proc_setup
      
      rem Initial positions of animals
      proc_init
      
      rem MAIN ROUTINE
      repeat
        rem Move the Sheep
        proc_sheepmove
        
        rem Move the DOG
        proc_dogmove
        
        rem Count dead sheep
        Dead%=fn_count
        
        a$=inkey$(5)
      until a$<>"" or Dead%=30
      
      if Dead%=30 then print tab(0,0);"All sheep are DEAD."
      
      a$=get$
      quit
      end
      rem End of Program ==============================================
      rem =============================================================
      
      rem Setup
      def proc_setup
      
      *FLOAT 64
      rem Go to full screen
      proc_fullscreen(xscreen%,yscreen%)
      
      xmax%=xscreen% : ymax%=yscreen%
      
      colour 130,0,50,0 : colour 2,0,50,0
      colour 4,150,75,0
      dim Sh%(30,2), Dg%(2)
      gcol 130 : clg : rem Grassy field
      endproc
      rem =============================================================
      
      rem Set up use of Full Screen
      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 Distance / Euclidean Metric Function
      def fn_met(X,Y)
      local euc
      
      euc=sqr(X*X + Y*Y)
      =euc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Initial positions of animals
      def proc_init
      
      rem Position the sheep initially
      gcol 7
      for a&=1 to 30
        Sh%(a&,1)=xmax%/2+rnd(xscreen%) : Sh%(a&,2)=ymax%/2+rnd(yscreen%)
        circle fill Sh%(a&,1),Sh%(a&,2),15
      next a&
      
      rem Initial position of the DOG
      Dg%(1)=rnd(2*xscreen%) : Dg%(2)=rnd(2*yscreen%)
      gcol 4 : circle fill Dg%(1),Dg%(2),13
      
      Dead%=0 : rem Initial number of dead sheep
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Identify the closest other sheep
      def proc_nearsheep
      local c&,dn,dth
      
      dn=5000 : id&=0
      for c&=1 to 30
        if ((c&<>b&) and (Sh%(c&,0)=0)) then
          dth=fn_met((Sh%(c&,1)-Sh%(b&,1)),(Sh%(c&,2)-Sh%(b&,2)))
          if dth<dn then id&=c& : dn=dth
        endif
      next c&
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Move the Sheep
      def proc_sheepmove
      local dsdg,md,dis,ph
      
      for b&=1 to 30
        if Sh%(b&,0)=0 then
          rem Identify the closest other sheep
          proc_nearsheep
          
          rem Find the distance to the DOG
          dsdg=fn_met((Dg%(1)-Sh%(b&,1)),(Dg%(2)-Sh%(b&,2)))
          
          rem Identify the direction towards the nearest other sheep
          rem Or the dog, if the dog is too close
          if dsdg<400 then
            blx=-(Dg%(1)-Sh%(b&,1)) : bly=-(Dg%(2)-Sh%(b&,2))
          else
            blx=Sh%(id&,1)-Sh%(b&,1) : bly=Sh%(id&,2)-Sh%(b&,2)
          endif
          md=fn_met(blx,bly)
          
          rem Delete the old position of the sheep to be moved
          gcol 2 : circle fill Sh%(b&,1),Sh%(b&,2),15
          
          if md>15 then
            rem If the sheep is far away, move towards it
            blx=blx/md : bly=bly/md
            if dsdg<400 then
              dis=25
              ps=rad(rnd(180)-90) : rem Random element to running away from the dog
            else
              dis=rnd(25) : if md<dis then dis=md/2
              ps=0
            endif
            rem Change direction vector +/- ps
            bux=blx*cos(ps) - bly*sin(ps)
            buy=blx*sin(ps) + bly*cos(ps)
            Sh%(b&,1)=Sh%(b&,1) + int(dis*bux)
            Sh%(b&,2)=Sh%(b&,2) + int(dis*buy)
          else
            rem If the nearest sheep is TOO close, move away
            ph=rad(rnd(360))
            Sh%(b&,1)=Sh%(b&,1) + 30*cos(ph)
            Sh%(b&,2)=Sh%(b&,2) + 30*sin(ph)
          endif
          
          rem Reposition the moving sheep
          gcol 7 : circle fill Sh%(b&,1),Sh%(b&,2),15
        else
          gcol 1 : circle fill Sh%(b&,1),Sh%(b&,2),15
        endif
      next b&
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Move the DOG
      def proc_dogmove
      local dns,jd%,d%,gth,dd,std
      
      gcol 2 : circle fill Dg%(1),Dg%(2),13
      rem Identify the nearest live sheep at this time
      dns=5000 : jd&=0
      for d&=1 to 30
        if Sh%(d&,0)=0 then
          gth=fn_met((Dg%(1)-Sh%(d&,1)),(Dg%(2)-Sh%(d&,2)))
          if gth<dns then jd&=d& : dns=gth
        endif
      next d&
      dlx=-(Dg%(1)-Sh%(jd&,1)) : dly=-(Dg%(2)-Sh%(jd&,2))
      dd=fn_met(dlx,dly)
      
      rem Decide how far the dog will run
      if dd>5 then
        dlx=dlx/dd : dly=dly/dd
        if dd>26 then
          std=26
        else
          std=dd : Sh%(jd&,0)=1
        endif
        rem Move the dog towards the sheep by the relevant distance
        Dg%(1)=Dg%(1) + int(std*dlx)
        Dg%(2)=Dg%(2) + int(std*dly)
        gcol 4 : circle fill Dg%(1),Dg%(2),13
        
        rem When the distance is close enough, KILL the sheep
        if std=dd then gcol 1 : circle fill Sh%(jd&,1),Sh%(jd&,2),15
      else
        Sh%(jd&,0)=1
        gcol 1 : circle fill Sh%(jd&,1),Sh%(jd&,2),15
      endif
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Count the dead sheep
      def fn_count
      local Dd%,i%
      
      Dd%=0
      for i&=1 to 30
        Dd%=Dd% + Sh%(i&,0)
      next i&
      =Dd%
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++