rem Polar Curves ........ Rev 1.1
      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 ===========================================================
      
      *FLOAT64
      proc_fullscreen(22)
      proc_theta : rem Defines a bit pattern for a "theta" character
      xmax%=1024 : ymax%=768 : rmax%=ymax%
      *FONT Arial,10,B
      
      print tab(5,10);" Press -m- 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
      
      proc_axes
      
      rem Identify Preset Curve details
      proc_iden
      
      for par%=0 to Num%
        parlit=Ps+((Pe-Ps)*(par%/Num%))
        vdu 19,2,16,0,(par%*255/Num%),((Num%-par%)*255/Num%) : gcol 2
        
        for t%=0 to Pts%
          
          Th=rad(Ths + ((The-Ths)*t%/Pts%))
          
          rem Computational Error Trapping
          on error local goto 1060
          
          rem Main calculation
          r=(hnv*rmax%)*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(y%)>1600) or (abs(x%)>2100) then goto 680
          
          plot 69,x%,y%
          
  680   next t%
        
      next par%
      a$=get$
      quit
      end
      
      rem End of Program +++++++++++++++++++++++++++++++++++++++
      
      rem Set up use of Full Screen
      def proc_fullscreen(N%)
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      mode N%
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      
      rem Sets up Axes
      def proc_axes
      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%=1000 : ffy%=0
        when "q","Q" : ffx%=1000 : ffy%=750
        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 Traps Computational Range Errors ONLY
 1060 if err=21 or err=23 or err=18 or err=20 or err=22 or err=24 then goto 680
      else restore error
      endif
      goto 680
      
      
      rem Main Calculation
      def fn_func(R$,a,t)
      rem R$ MUST be expressed in terms of t and a !!!
      
      =eval(R$)
      
      rem Menu of Preset Curves
      def proc_menu
      
      print tab(5,10);"Pick one of the curves from the list below, by pressing the relevant number."
      
      print tab(10,15);"1 CIRCLE "
      print tab(10,17);"2 PARABOLA"
      print tab(10,19);"3 CARDIOID"
      print tab(10,21);"4 DOUBLE FOLIUM"
      print tab(10,23);"5 COCHLEOID"
      print tab(10,25);"6 LEMNISCATE of Bernoulli"
      print tab(10,27);"7 LIMACON of Pascal"
      print tab(10,29);"8 LITUUS"
      print tab(10,31);"9 RIGHT STROPHOID"
      
      repeat
      a$=get$
      as%=asc(a$)-48
      until (as%>0 and as%<10)
      cls
      case as% of
      when 1 : print tab(5,10);"You have chosen the CIRCLE."
        Curv$=" The CIRCLE"
        r$="a"
      when 2 : print tab(5,10);"You have chosen the PARABOLA."
        Curv$="The PARABOLA"
        r$="(a*COS(t))/(SIN(t)*SIN(t))"
      when 3 : print tab(5,10);"You have chosen the CARDIOID."
        Curv$="The CARDIOID"
        r$="a*(1+COS(t))/2"
      when 4 : print tab(5,10);"You have chosen the DOUBLE FOLIUM."
        Curv$="The DOUBLE FOLIUM"
        r$="3*a*COS(t)*SIN(t)*SIN(t)"
      when 5 : print tab(5,10);"You have chosen the COCHLEOID."
        Curv$="The COCHLEOID"
        r$="(a*SIN(t))/t"
      when 6 : print tab(5,10);"You have chosen the LEMNISCATE of Bernoulli."
        Curv$="The LEMNISCATE of Bernoulli"
        r$="a*SQR(COS(2*t))"
      when 7 : print tab(5,10);"You have chosen the LIMACON of Pascal."
        Curv$="The LIMACON of Pascal"
        r$="(1+(2*a*COS(t)))/2"
      when 8 : print tab(5,10);"You have chosen the LITUUS."
        Curv$="The LITUUS"
        r$="a/(SQR(t))"
      when 9 : print tab(5,10);"You have chosen the RIGHT STROPHOID."
        Curv$="The RIGHT STROPHOID"
        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 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 Default values of parameters
      def proc_defpars
      
      Ps=0 : Pe=1
      Ths=0 : The=360
      hnv=1
      Pts%=5000
      
      endproc
      
      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 Identify Preset Curve details
      def proc_iden
      *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