rem COBWEBS ............. Rev 2.4
      rem A J Tooth /Modified 25th Jan & 13th Sept 2003
      rem Minor modifications made July 2004
      rem Modified March 2006
      
      on error if (err=17) then quit
      
      rem Setup
      proc_setup
      
      *REFRESH OFF
      repeat
        rem Fix Origin and Colour of next Cobweb
        proc_OrCol
        
        rem Cobweb drawing Section
        proc_Draw
        *REFRESH
        
        rem Clear screen to new Colour when max number of cobwebs plotted
        proc_Cls
        
        a$=inkey$(1)
        rem Keep going until the a key is pressed
      until a$<>""
      *REFRESH ON
      r$=get$
      
      quit
      end
      rem End of Program ++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Setup
      def proc_setup
      
      *FLOAT 64
      
      proc_fullscreen(xscreen%,yscreen%) : rem Set up use of Full Screen
      
      dim x%(25),y%(25)
      
      rem Various control variables
      tck&=0 : t&=10 : cnt%=0 : lmt%=100 : rem lmt% is the max number of Cobwebs
      
      rem Initial background colour is BLACK
      rr&=0 : gg&=0 : bb&=0 : cl&=10
      colour 130,rr&,gg&,bb&
      colour 130 : cls
      endproc
      rem ===============================================================
      
      rem Cobweb drawing Section
      def proc_Draw
      local a&,fc,rm&,gm&,bm&,s&,l&,d&,angle
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      for a&=cl& to 1 step-1
        rem Reduce width of line, merging back/fore-ground colours
        @vdu%!248=a&
        fc=a&/cl&
        rm&=int(rr&*fc + r&*(1-fc))
        gm&=int(gg&*fc + g&*(1-fc))
        bm&=int(bb&*fc + b&*(1-fc))
        colour 10,rm&,gm&,bm& : gcol 10
        
        rem Draw radii
        for s&=1 to side&
          angle=(s&-1)*2*pi/side&
          x%(s&)=int(rdius%*cos(rad(twisth%))*cos(angle))
          y%(s&)=int(rdius%*cos(rad(twistv%))*sin(angle))
          move 0,0
          plot 5,x%(s&),y%(s&)
        next
        rem Draw radial links
        for l&=1 to 8
          for d&=1 to (side&-1)
            move x%(d&)*l&/t&,y%(d&)*l&/t&
            plot 5,x%(d&+1)*l&/t&,y%(d&+1)*l&/t&
          next
          move x%(side&)*l&/t&,y%(side&)*l&/t&
          plot 5,x%(1)*l&/t&,y%(1)*l&/t&
        next
      next a&
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      endproc
      
      rem ===============================================================
      
      rem Defines Origin and Colours
      def proc_OrCol
      local xor%, yor%
      
      rem Fix origin of next Cobweb
      xor%=rnd(2*xscreen%) : yor%=rnd(2*yscreen%) : rdius%=rnd(350)+100
      rem Redefine Graphics origin as centre of next Cobweb
      vdu 29,xor%;yor%;
      
      side&=rnd(20)+3 : rem Fix number of radii
      rem Set random angles by which each cobweb is rotated
      twisth%=rnd(80) : twistv%=rnd(80)
      
      rem Choose random colour with overall red, green or blue hue
      if cnt%=0 then tck&+=1 : if tck&=4 then tck&=1
      case tck& of
        when 1 :  r&=2*?lmt% : g&=rnd(256)-1 : b&=rnd(256)-1
        when 2 :  r&=rnd(256)-1 : g&=2*?lmt% : b&=rnd(256)-1
        when 3 :  r&=rnd(256)-1 : g&=rnd(256)-1 : b&=2*?lmt%
        otherwise error
      endcase
      endproc
      
      rem ===============================================================
      
      rem Clear Screen to Random Background Colour
      def proc_Cls
      local h&,gr&
      
      cnt%+=1
      if cnt%=lmt%*(1-(h&=4)) then
        h&=rnd(5)-1
        gr&=100+rnd(155)
        rr&=-gr&*(h&=4)-(h&=1)*30
        gg&=-gr&*(h&=4)-(h&=2)*30
        bb&=-gr&*(h&=4)-(h&=3)*30
        
        colour 130,rr&,gg&,bb&
        colour 130 : cls
        cnt%=0
      endif
      endproc
      
      rem ===============================================================
      
      rem Goto fullscreen mode
      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 ===============================================================