rem 3-D FAMILIES OF CURVES .... Rev 6.1
      rem A J Tooth / 8th Dec 2002 Revised 21st June 2006
      on error if (err=17) then quit
      
      rem Plots a scalable family of Functions of x and z on a full, blank screen.
      *FLOAT 64
      *LOWERCASE ON
      
      rem Set up use of Full Screen
      proc_fullscreen
      
      rem Defines ASCII character 128 as a symbol for Pi
      proc_pi
      rem Defines ASCII character 129 as a symbol for a "dot"
      proc_dot
      
      repeat
        rem Choose colour scheme dependant on whether printing required
        proc_colset
        
        rem Enter Function
        proc_entry
        
        repeat
          rem Go Round Again with same Expression Option
          proc_pream
          
          rem Curve Drawing Section
          gcol 2
          st%=(ffx%-xmax%)-750 : fm%=(ffx%+xmax%)+750
          
          for par%=lim% to 0 step -1
            parlit=zs+((ze-zs)*(par%/lim%))
            
            for x%=st% to fm%
              rem Computational Error Trapping
              on error local goto 900
              rem Format variable to pass to Expression Evaluation routine
              pass=x%*hor/xmax%
              
              rem Main calculation
              y=(ver*ymax%)*fn_func(xpr$,pass,parlit)
              
              rem Plot formatting section
              s%=sgn(y) : y%=s%*int(abs(y))
              
              rem 3-D Adjustments
              plx%=x%+int(per*parlit*cos(rad(zaa%)))
              ply%=y%+int(per*parlit*sin(rad(zaa%)))
              if abs(ply%)>3200 then goto 580
              if x%=-xmax% then move x%,y%
              
              if y%<0 then Red&=int(255/(1+ln((1-y%)/100))) : Gre&=0
              if y%>0 then Gre&=int(255/(1+ln((1+y%)/100))) : Red&=0
              if y%=0 then Red&=0 : Gre&=0
              colour 2,Red&,Gre&,50 : gcol 2
              
              plot plx%,ply%
              
              a$=inkey$(0) : if a$="x" then x%=fm% : par%=lim%
  580       next x%
          next par%
          
          rem Re-Displays Expression for Reference
          proc_exdis
          
          rem Stop and Re-Run or QUIT
          repeat until inkey(0)=-1
          
          sp$=get$
          if sp$="s" or sp$="S" then
            proc_hcopy(0,0,1024,768,0,0,8,11)
          else
            print tab(10,10);"Screen will not be printed. Press any key to continue."
          endif
          
          rep$=get$
          clg : print tab(10,10);"Do you want to use the same expression? ( y or n )"
          rep$=get$ : cls
          if rep$="y" or rep$="Y" then flag&=1 else flag&=2
        until flag&<>1
        
        print tab(10,10);"Enter another expression, or QUIT the programme? ( y or q )"
        rep$=get$ : cls
        if rep$="y" or rep$="Y" then flag&=1 else flag&=2
      until flag&<>1
      
      quit
      end
      rem End of Program ............................................................
      rem ...........................................................................
      
      rem Main Calculation
      def fn_func(main$,x,z)
      rem main$ MUST be expressed in terms of X and Z !!!
      =eval(main$)
      rem ...........................................................................
      
      rem Traps Computational Range Errors ONLY
  900 if err=21 or err=23 or err=18 or err=20 or err=22 or err=24 then goto 580
      else restore error
      endif
      goto 580
      rem ...........................................................................
      
      rem Sets the colour scheme
      def proc_colset
      
      cls : colour 3
      print tab(5,5);"To PRINT the screen, once the curves have all been plotted, press -s- to print the output."
      print tab(5,7);" THERE WILL BE NO PROMPT !!!!! "
      print tab(5,9);"Press -i- NOW to use a WHITE background"
      inv$=get$
      if inv$="i" or inv$="I" then
      colour 128,15 : colour 7,0 : colour 11,4 : colour 2,0 : colour 3,1
      else
      colour 128,0 : colour 7,7 : colour 3,3 : colour 2,2 : colour 11,11
      endif
      origin 0,0 : cls
      endproc
      rem ...........................................................................
      
      rem Initialisation Procedure
      def proc_pream
      
      print tab(5,25);" What end-points do you want for Z ?"
      print " Z Start (0) ":colour 9:input zs
      colour 11:print " Z End (1) ":colour 9:input ze
      if ze=0 then ze=1
      colour 11:print " X-Axis Scale (1) ":colour 9:input hor
      if hor=0 then hor=1
      colour 11:print " Y-Axis Scale (1) ":colour 9:input ver
      if ver=0 then ver=1
      ver=0.4*ver
      colour 11:print " Z-Axis Scale (1) ":colour 9:input per
      if per=0 then per =1
      per=500*per
      colour 11:print " Z-Axis Angle ( 1 to 179 )(60)  ":colour 9:input zaa%
      if zaa%=0 then zaa%=60
      colour 11:print " How many curves (100)":colour 9:input lim%
      if lim%=0 then lim%=100
      
      xmax%=xscreen% : ymax%=yscreen%
      
      rem Place Origin and draw Axes
      colour 11:print " 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%)
      xz%=int(2560*cos(rad(zaa%))) : yz%=int(2560*sin(rad(zaa%)))
      move 0,0 : draw xz%,yz% : move 0,0 : draw -xz%,-yz%
      
      rem Displays Expression for Reference
      proc_exdis
      endproc
      rem ...........................................................................
      
      rem Displays Expression for Reference
      def proc_exdis
      
      Strl%=len(xpr$)
      Xpr$=""
      for j%=1 to Strl%
      t$=mid$(xpr$,j%,1)
      if t$="*" then Xpr$=Xpr$+chr$(129) else Xpr$=Xpr$+t$
      next j%
      repeat
      is%=instr(Xpr$,"PI") + 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 3 : print tab(0,0);"F(X,Z)=";Xpr$
      endproc
      rem ...........................................................................
      
      rem Set up use of Full Screen
      def proc_fullscreen
      
      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 PRINTS the final screen to a printer
      def proc_hcopy(xa%, ya%, wa%, ha%, xb%, yb%, wb%, hb%)
      local sx%,sy%
      
      vdu 2
      vdu 2,1,32,3
      sys "GetDeviceCaps", @prthdc%, 88 to sx%
      sys "GetDeviceCaps", @prthdc%, 90 to sy%
      sys "StretchBlt",@prthdc%, xb%*sx%, yb%*sy%, wb%*sx%, hb%*sy%, @memhdc%, xa%, ya%, wa%, ha%, &CC0020
      vdu 3
      endproc
      rem ...........................................................................
      
      rem Enter Function
      def proc_entry
      
      gcol 12 : rectangle fill 150,900,1400,430
      gcol 8 : rectangle fill 155,905,1390,420
      colour 136 : colour 11
      print tab(10,7);" Will accept SIN, COS, TAN, EXP, LN, LOG - must ALL be UPPER CASE or ALL LOWER CASE."
      print tab(10,8);" Also ArcSine = ASN, similar for ACS and ATN. "
      print tab(10,10);" Use SQR for Square Root. "
      print tab(10,12);" Use * to multiply. "
      print tab(10,14);" Use ^ to raise to a power eg x^3 is x cubed. "
      print tab(10,16);" Use DEG to convert radians to degrees, RAD to convert degrees to radians."
      print tab(10,18);" Also accepts PI - again must be upper case."
      colour 128
      print tab(5,5);" Enter a Function or Expression in terms of x and z "
      colour 9 : input tab(60,5);xpr$ : colour 11
      endproc
      rem ...........................................................................
      
      rem Defines ASCII character 128 as a symbol for Pi
      def proc_pi
      local r1%,r2%,r3%,r4%,r5%,r6%,r7%,r8%
      
      r2%= %00000000
      r3%= %11111111
      r4%= %01101100
      r5%= %01101100
      r6%= %01100110
      r7%= %00000000
      r8%= %00000000
      r1%= %00000000
      
      vdu 23,128,r2%,r3%,r4%,r5%,r6%,r7%,r8%,r1%
      endproc
      rem ...........................................................................
      
      rem Defines ASCII character 129 as a symbol for a "dot"
      def proc_dot
      local r1%,r2%,r3%,r4%,r5%,r6%,r7%,r8%
      
      r2%= %00000000
      r3%= %00000000
      r4%= %00000000
      r5%= %00010000
      r6%= %00000000
      r7%= %00000000
      r8%= %00000000
      r1%= %00000000
      
      vdu 23,129,r2%,r3%,r4%,r5%,r6%,r7%,r8%,r1%
      endproc
      rem ...........................................................................