rem Polar Curves ........ Rev 1.5
      rem A J Tooth // 28th December 2003
      rem ===========================================================
      rem Displays curves expressed in Polar co-ordinates, r=F(Theta)
      rem Subject to a single parameter, a
      rem ===========================================================
      
      on error if (err=17) then quit
      *FLOAT64
      
      rem Set up
      proc_setup
      
      repeat
        rem Choose a curve
        cls : proc_Choice
        
        *REFRESH OFF
        
        rem Main Procedure
        proc_Main
        
        *REFRESH ON
        a$=get$
      until a$<>" "
      
      quit
      rem End of Program ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      rem =============================================================================
      
      rem Set up
      def proc_setup
      
      rem Go to full screen
      proc_fullscreen(xscreen%,yscreen%)
      
      proc_theta : rem Defines a bit pattern for a "theta" character
      
      xmax%=xscreen% : ymax%=yscreen% : rmax%=ymax%
      *FONT Arial,10,B
      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 Choose a curve
      def proc_Choice
      local m$
      
      colour 15 : print tab(5,10);" Press - ";
      colour 9 : print;"m";
      colour 15 : print;" - to pick a curve from a pre-set list, or any other key to enter your own."
      m$=get$
      case m$ of
        when "m", "M" : cls:proc_menu
        otherwise
          cls:proc_default
      endcase
      
      rem Display axes
      proc_axes
      
      rem Identify Preset Curve details
      proc_iden
      endproc
      rem =============================================================================
      
      rem Sets up Axes
      def proc_axes
      local ch$,ffx%,ffy%,setx%,sety%
      
      print tab(10,25);" Choose Centred (c) or Positive Half-Plane (h) or 1st Quadrant only (q) "
      ch$=get$ : cls
      case ch$ of
        when "c","C" : ffx%=0 : ffy%=0
        when "h","H" : ffx%=xscreen%-20 : ffy%=0
        when "q","Q" : ffx%=xscreen%-20 : ffy%=yscreen%-20
        otherwise
          ffx%=0 : ffy%=0
      endcase
      
      setx%=(xmax%-ffx%) : sety%=(ymax%-ffy%)
      origin setx%,sety% : gcol 3
      move (-xmax%+ffx%),0 : draw (xmax%+ffx%),0
      move 0,(-ymax%+ffy%) : draw 0,(ymax%+ffy%)
      endproc
      rem =============================================================================
      
      rem Main Procedure
      def proc_Main
      
      for par%=0 to Num%
        parlit=Ps+((Pe-Ps)*(par%/Num%))
        
        rem Colour adjustment
        cl&=int(par%*255/Num%)
        colour 2,0,cl&,255-cl& : gcol 2
        fac=hnv*rmax%
        
        for t%=0 to Pts%
          
          Th=rad(Ths + ((The-Ths)*t%/Pts%))
          
          rem Computational Error Trapping
          on error local goto 1350
          
          rem Main calculation
          r=fac*fn_func(r$,parlit,Th)
          x=r*cos(Th) : y=r*sin(Th)
          
          rem Plot formatting section
          sy%=sgn(y) : sx%=sgn(x)
          x%=sx%*int(abs(x))
          y%=sy%*int(abs(y))
          
          if (abs(x%)<2*xscreen% and abs(y%)<2*yscreen%) then plot x%,y%
          
 1280   next t%
        *REFRESH
      next par%
      endproc
      rem =============================================================================
      
      rem Traps Computational Range Errors ONLY
 1350 if err=21 or err=23 or err=18 or err=20 or err=22 or err=24 then goto 1280
      else restore error
      endif
      goto 1280
      rem =============================================================================
      
      rem Main Calculation
      def fn_func(R$,a,t)
      =eval(R$)
      rem =============================================================================
      
      rem Menu of Preset Curves
      def proc_menu
      local a&,as&,as%
      
      if Z%=0 then
      dim Curve$(9)
      restore
      for a&=1 to 9
        read Curve$(a&)
      next a&
      Z%=1
      endif
      
      print tab(5,10);"Pick one of the curves from the list below, by pressing the relevant number."
      
      for a&=1 to 9
      colour 9 : print tab(10,13+2*a&);a&;" ";
      colour 15 : print;Curve$(a&)
      next a&
      
      repeat
      a$=get$
      as%=asc(a$)-48
      until (as%>0 and as%<10)
      cls
      
      as&=as%
      
      print tab(5,10);"You have chosen the ";Curve$(as&)
      Curv$="The "+ Curve$(as&)
      
      case as& of
      when 1 : r$="a"
      when 2 : r$="(a*COS(t))/(SIN(t)*SIN(t))"
      when 3 : r$="a*(1+COS(t))/2"
      when 4 : r$="3*a*COS(t)*SIN(t)*SIN(t)"
      when 5 : r$="(a*SIN(t))/t"
      when 6 : r$="a*SQR(COS(2*t))"
      when 7 : r$="(1+(2*a*COS(t)))/2"
      when 8 : r$="a/(SQR(t))"
      when 9 : r$="a*COS(2*t)/COS(t)"
      endcase
      
      input tab(10,12);" How many curves to show (10)",Num%
      if Num%=0 then Num%=10
      proc_defpars
      endproc
      rem =============================================================================
      
      rem Curve Names
      data "CIRCLE","PARABOLA","CARDIOID","DOUBLE FOLIUM","COCHLEOID","LEMNISCATE of Bernoulli","LIMACON of Pascal","LITUUS","RIGHT STROPHOID"
      rem =============================================================================
      
      rem Default to self-entry of Expression and Parameters
      def proc_default
      print " Input the Expression for R in terms of the angle, t, and a parameter, a"
      print:input " Enter the Expression here:  ",r$
      
      print " What limits do you want for the main Parameter, a ?"
      print:input " a Start (0)",Ps," a End (1)",Pe
      if Pe=0 then Pe=1
      
      print:print " What end-points (in degrees) do you want for the Angle, Theta ? "
      print:input " Theta Start (0)",Ths," Theta End (360)",The
      if The=0 then The=360
      
      print:input " Axis Scale (1) ",hnv
      if hnv=0 then hnv=1
      print:input " How many plot points (2000)",Pts%
      if Pts%=0 then Pts%=2000
      
      print:input " How many curves (10)",Num%
      if Num%=0 then Num%=10
      print:input " Enter a NAME for the curve, if required, otherwise just press -Enter-.",Curv$
      endproc
      rem =============================================================================
      
      rem Default values of parameters
      def proc_defpars
      
      Ps=0 : Pe=1
      Ths=0 : The=360
      hnv=1
      Pts%=4000
      
      endproc
      rem =============================================================================
      
      rem Defines ASCII character 129 as a symbol for Theta
      def proc_theta
      local r1%,r2%,r3%,r4%,r5%,r6%,r7%,r8%
      
      r1%= %00000000
      r2%= %00111100
      r3%= %01100110
      r4%= %01111110
      r5%= %01100110
      r6%= %00111100
      r7%= %00000000
      r8%= %00000000
      
      vdu 23,129,r1%,r2%,r3%,r4%,r5%,r6%,r7%,r8%
      endproc
      rem =============================================================================
      
      rem Identify Preset Curve details
      def proc_iden
      local l&,z&
      
      *FONT Desdemona,16,B
      colour 1: print tab(2,1);Curv$
      *FONT Arial,10,B
      l&=len(r$)
      pr$=""
      colour 3
      for z&=1 to l&
      tr$=mid$(r$,z&,1)
      case tr$ of
        when "t" : pr$=pr$+chr$(129)
        when "*" : pr$=pr$+"."
        otherwise
          pr$=pr$+tr$
      endcase
      next z&
      
      print tab(2,4);"Polar Form: r=";pr$
      endproc
      rem =============================================================================