rem Implicit Curves ....... Rev 3.1
      rem A J Tooth // 30th July 2004
      rem Revised 18th March 2007
      on error if (err=17) then quit
      
      install @lib$+"MyUtils.bbc"
      
      rem Set up
      proc_setup
      
      rem Draw curve
      proc_main
      
      *REFRESH ON
      rem Draw Axes and display Function
      proc_finish
      
      a$=get$
      if a$="r" or a$="R" then run
      quit
      end
      
      rem End of Program +++++++++++++++++++++++++++++++++++++++++++++
      rem ============================================================
      
      rem Set up
      def proc_setup
      
      *FLOAT64
      *LOWERCASE ON
      
      rem Go to full screen
      proc_fullscreen(xscreen%,yscreen%)
      
      rem Creates ASCII character for Pi
      proc_pi
      
      rem Enter F(x,y)=0 and Parameters
      proc_entry
      
      rem Preamble
      Xmax%=xscreen% : Xlim%=yscreen% : Ylim%=yscreen%
      
      origin Xmax%,Ylim%
      *REFRESH OFF
      gcol 11 : rem Bright Yellow for Plotting
      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 Traps Computational Range Errors ONLY
  670 if err=21 or err=23 or err=18 or err=20 or err=22 or err=24 then goto 1320
      else restore error
      endif
      goto 1320
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Enter Function
      def proc_entry
      
      rem Display my Icon in compiled version
      proc_AJTicon(10,7*yscreen%/8)
      
      gcol 12 : rectangle fill 150,int(900*yscreen%/768),1220,int(500*yscreen%/768)
      gcol 8 : rectangle fill 155,int(905*yscreen%/768),1210,int(490*yscreen%/768)
      vdu 5
      msg$="\3Will accept \2SIN, COS, TAN, EXP, LN, LOG - "
      proc_msg("Georgia",12,"",200,int(1350*yscreen%/768),msg$)
      msg$="\3Can be \1LOWER \3or \1UPPER \3case, but not mixed e.g. not Sin."
      proc_msg("Georgia",12,"",200,int(1300*yscreen%/768),msg$)
      msg$="\3Also ArcSine = \2ASN\3, similar for \2ACS \3and \2ATN\3. "
      proc_msg("Georgia",12,"",200,int(1250*yscreen%/768),msg$)
      msg$="\3Use \2SQR for Square Root. "
      proc_msg("Georgia",12,"",200,int(1200*yscreen%/768),msg$)
      msg$="\3Use \2* \3to multiply. "
      proc_msg("Georgia",12,"",200,int(1150*yscreen%/768),msg$)
      msg$="\3Use \2^ \3to raise to a power eg x^3 is x cubed. "
      proc_msg("Georgia",12,"",200,int(1100*yscreen%/768),msg$)
      msg$="\3Use \2DEG \3to convert radians to degrees, \2RAD \3to convert degrees to radians."
      proc_msg("Georgia",12,"",200,int(1050*yscreen%/768),msg$)
      msg$="\3Also accepts \2PI \3or pi - but \1NOT \3Pi."
      proc_msg("Georgia",12,"",200,int(1000*yscreen%/768),msg$)
      vdu 4
      
      colour 3 :  print tab(10,25);"Enter IMPLICIT Function F(x,y): ";
      colour 9:input Func$ : colour 3
      
      print tab(10,26);"Enter x-range (5)";
      colour 9:input Xe : colour 3
      if Xe=0 then Xe=5
      Xe=4*Xe/3
      print tab(10,27);"Enter y-range (5)";
      colour 9:input Ye : colour 3
      if Ye=0 then Ye=5
      print tab(10,29);"Press -q- for QUICK, -s- for SLOW output ";
      ch$=get$
      if ch$<>"s" then ch$="q"
      colour 9:print ch$
      Stp%=xscreen%
      Sen=50.0
      cls
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Draw curve
      def proc_main
      local p%,q%,c%,r&,g&,b&,xp%,yp%
      
      if ch$="q" then
      msx&=2 : msy&=4
      else
      msx&=1 : msy&=2
      endif
      
      for p%=0 to Stp% step msx&
      x=-Xe + 2*Xe*(p%/Stp%)
      xx=Xmax%*(x/Xe)
      sx%=sgn(xx) : xp%=2*p%-Xmax%
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      for q%=0 to Stp% step msy&
        rem Computational Error Trapping
        on error local goto 670
        
        y=-Ye + 2*Ye*(q%/Stp%)
        
        yy=Ylim%*(y/Ye)
        Res=eval(Func$)
        sy%=sgn(yy) : yp%=sy%*int(abs(yy))
        
        if abs(Res)>0.001 then
          c%=int(Sen*ln(abs(1/Res)))
        else
          c%=255
        endif
        
        if c%>255 then c%=255
        if c%<-255 then c%=-255
        
        if c%>=0 then r&=c% : g&=c% : b&=c%
        if c%<0 then r&=0 : g&=0 : b&=-int(c%/4)
        
        rem Plot the point
        proc_PntPlot(xp%,yp%)
        
 1320 next q%
      *REFRESH
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      
      a$=inkey$(0)
      next p%
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Draw Axes and display Function
      def proc_finish
      
      gcol 1
      move -Xmax%,0 : draw Xmax%,0
      move 0,-Ylim% : draw 0,Ylim%
      
      rem Display Function
      proc_disp(Func$)
      
      rem Display my icon in compiled version
      proc_AJTicon(50,7*yscreen%/8)
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Displays Expression for Reference
      def proc_disp(F$)
      
      Strl%=len(F$)
      Xpr$=""
      
      for j%=1 to Strl%
      t$=mid$(F$,j%,1)
      if t$="*" then Xpr$=Xpr$+"" else Xpr$=Xpr$+t$
      next j%
      
      repeat
      is%=instr(Xpr$,"pi")
      if is%>0 then
        StrX%=len(Xpr$)
        mid$(Xpr$,is%,1)=chr$(128)
        right$(Xpr$,(StrX%-is%))=right$(Xpr$,(StrX%-is%-1))+" "
      endif
      until is%=0
      
      colour 2: colour 136 :print tab(0,0);"F(x,y)=  ";
      colour 1:print Xpr$;
      colour 2:print " = 0  ";
      
      endproc
      rem ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      
      rem Defines ASCII character 128 as a symbol for Pi
      def proc_pi
      local r1%,r2%,r3%,r4%,r5%,r6%,r7%,r8%
      
      r1%= %00000000
      r2%= %00000000
      r3%= %11111111
      r4%= %01101100
      r5%= %01101100
      r6%= %01100110
      r7%= %00000000
      r8%= %00000000
      vdu 23,128,r1%,r2%,r3%,r4%,r5%,r6%,r7%,r8%
      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 ===============================================================
      
      rem Plot a point
      def proc_PntPlot(Xp%,Yp%)
      
      private Pltt%,P%
      
      if Pltt%=0 then
      dim P% 200
      
      [opt 2
      .Pltt%
      
      mov al,19              ;Changes the rgb vlue f0r colr 10
      call "oswrch"
      mov al,10
      call "oswrch"
      mov al,16
      call "oswrch"
      mov al,[^r&]
      call "oswrch"
      mov al,[^g&]
      call "oswrch"
      mov al,[^b&]
      call "oswrch"
      
      mov al,18              ;Calls gc0l routine
      call "oswrch"
      mov al,0
      call "oswrch"
      mov al,10
      call "oswrch"
      
      mov al,25              ;Calls Plot routine
      call "oswrch"
      mov al,69
      call "oswrch"
      mov bx,[^Xp%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[^Yp%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      
      ret
      ]
      endif
      
      call Pltt%
      
      endproc
      rem ===================================================================