// °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
// 
// An RF Impedance Calculator
// 
// Copyright © 2001-2002 by Harry Whitfield, G6AUC. All Rights Reserved.
// 
// Broadly based on NETCALC - an RF Impedance Calculator by Ian White, G3SEK.
// 
// The concepts and command names follow NETCALC, but the coding and design
// of this REALbasic program are entirely new.
// 
// This program can also display impedances on a diagram similar to the
// well-known Smith Chart.
// 
// The L-section code is based on a PERL program
// by Claude Frantz <claude@pc0312a.rz.unibw-muenchen.de>
// 
// °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°

NetCalc.update:
Sub update()
  Dim rh As String
  // recompute variables
  Ps=Parform(Xs)
  Ns=cdiv(Xs,Z0s)
  rh=rho(Xs,Z0s)
  modrho=modulus(rh)
  argrho = arg(rh)
  Zs="VSWR=" + Str(VSWR(rh)) +" "+"RL=" + Str(ReturnLoss(rh)) + "dB"
  
  // copy variables to fields
  X.Text=Xs
  Y.Text=Ys
  P.Text=Ps
  Z0.Text=Z0s
  N.Text=Ns
  R.Text=Str(modrho)+" @ "+Str(180*argrho/pi)+"¡"
  Z.Text=Zs
End Sub

NetCalc.Parform:
Function Parform(z1 As String) As String
  Dim r1,x1,ms As Double
  r1=Re(z1)
  x1=Im(z1)
  ms=(r1*r1 + x1*x1)
  if (ms = 0) then
    return Cx(0,0)
  else
    return Cx(ms/r1,ms/x1)
  end if
End Function

NetCalc.VSWR:
Function VSWR(z1 As String) As Double
  Dim r1,x1,r As Double
  r1=Re(z1)
  x1=Im(z1)
  r=Sqrt(r1*r1+x1*x1)
  return (1+r)/(1-r)
End Function

NetCalc.ReturnLoss:
Function ReturnLoss(z1 As String) As Double
  Dim r1,x1 As Double
  r1=Re(z1)
  x1=Im(z1)
  return -10*Log10(r1*r1+x1*x1)
End Function

NetCalc.rho:
Function rho(Z1 As String, Z0 As String) As String
  Dim z,unity As String
  z=cdiv(Z1,Z0)
  unity="1,0"
  return cdiv(csub(z,unity),cadd(z,unity))
End Function

NetCalc.Log10:
Function Log10(x as Double) As Double
  return Log(x)/Log(10)
End Function

NetCalc.Re:
Function Re(Z As String) As Double
  return Val(Left(Z,InStr(Z,",")-1))
End Function

NetCalc.Im:
Function Im(Z As String) As Double
  return Val(Mid(Z,InStr(Z,",")+1))
End Function

NetCalc.Cx:
Function Cx(R As Double, X As Double) As String
  return Str(R)+","+Str(X)
End Function

NetCalc.modulus:
Function modulus(z1 As String) As Double
  Dim r1,x1 As Double
  r1=Re(z1)
  x1=Im(z1)
  return Sqrt(r1*r1 + x1*x1)
End Function

NetCalc.cadd:
Function cadd(z1 As String,z2 As String) As String
  Dim r1,x1,r2,x2 As Double
  r1=Re(z1)
  x1=Im(z1)
  r2=Re(z2)
  x2=Im(z2)
  return Cx(r1+r2,x1+x2)
End Function

NetCalc.csub:
Function csub(z1 As String, z2 As String) As String
  Dim r1,x1,r2,x2 As Double
  r1=Re(z1)
  x1=Im(z1)
  r2=Re(z2)
  x2=Im(z2)
  return Cx(r1-r2,x1-x2)
End Function

NetCalc.smul:
Function smul(s As Double, z1 As String) As String
  Dim r1,x1 As Double
  r1=Re(z1)
  x1=Im(z1)
  return Cx(s*r1,s*x1)
End Function

NetCalc.sdiv:
Function sdiv(s As Double, z1 As String) As String
  Dim r1,x1 As Double
  if (s = 0) then
    if modsqr(z1) = 0 then
      return UNDEFINED
    end if
    return INFINITY
  end if
  r1=Re(z1)
  x1=Im(z1)
  return Cx(r1/s,x1/s)
End Function

NetCalc.modsqr:
Function modsqr(z1 As String) As Double
  Dim r1,x1 As Double
  r1=Re(z1)
  x1=Im(z1)
  return (r1*r1 + x1*x1)
End Function

NetCalc.conj:
Function conj(z1 As String) As String
  Dim r1,x1 As Double
  r1=Re(z1)
  x1=Im(z1)
  return Cx(r1,-x1)
End Function

NetCalc.arg:
Function arg(z1 As String) As Double
  Dim r1,x1 As Double
  // result in -¹ < arg <= ¹
  r1=Re(z1)
  x1=Im(z1)
  if r1 = 0 then
    if x1 = 0 then
      return 0/0
    elseif x1 > 0 then
      return pi/2
    else
      return -pi/2
    end if
  elseif r1 > 0 then
    return atan(x1/r1)
  elseif x1 >= 0 then
    return atan(x1/r1) + pi
  else
    return atan(x1/r1) - pi
  end if
End Function

NetCalc.cdiv:
Function cdiv(z1 As String, z2 As String) As String
  Dim ms As Double
  ms =  modsqr(z2)
  if (ms = 0) then
    if modsqr(z1) = 0 then
      return UNDEFINED
    else
      return INFINITY
    end if
  end if
  return smul(1/ms,cmul(z1,conj(z2)))
End Function

NetCalc.cmul:
Function cmul(z1 As String, z2 As String) As String
  Dim r1,x1,r2,x2 As Double
  r1=Re(z1)
  x1=Im(z1)
  r2=Re(z2)
  x2=Im(z2)
  return Cx(r1*r2 - x1*x2, r1*x2 + r2*x1)
End Function

NetCalc.par:
Function par(z1 As String, z2 As String) As String
  Dim z As String
  if (modsqr(z1) = 0) or (modsqr(z2) = 0) then 
    return "0,0"
  end if
  z = cadd(z1,z2)
  if modsqr(z) = 0 then
    return INFINITY
  else
    return cdiv(cmul(z1,z2),z)
  end if
End Function

NetCalc.gFrequency:
Function gFrequency() As Double
   return Val(Freq.Text) * Pow(10, FMultiplier)
End Function

NetCalc.gResistance:
Function gResistance() As Double
  return Val(Resistance.Text) * Pow(10, RMultiplier)
End Function

NetCalc.gInductance:
Function gInductance() As Double
  return Val(Inductance.Text) * Pow(10, LMultiplier)
End Function

NetCalc.gReactance:
Function gReactance() As Double
  return Val(Reactance.Text) * Pow(10, XMultiplier)
End Function

NetCalc.gCapacitance:
Function gCapacitance() As Double
  return Val(Capacitance.Text) * Pow(10, CMultiplier)
End Function

NetCalc.gVelocity:
Function gVelocity() As Double
  return Val(Velocity.Text)
End Function

NetCalc.equivLength:
Function equivLength(Z1 As String, Z0 As String , f As Double, v As Double) As Double
  // length of transmission line of characteristic impedance Z0 having
  // the same reactance at frequency f as the impedance Z1.
  // v is the speed of transmission in the line = speed of light * velocity factor.
  Dim Z As String
  Dim x As Double
  Z = cdiv(Z1,Z0)
  x = atan(Im(Z))
  if x < 0 then 
    x = x + pi 
  end if
  return x*v/(2*pi*f)
End Function

NetCalc.Zin:
Function Zin(Z1 As String, Z0 As String, x As Double) As String
  // input impedance of a lossless transmission line of characteristic impedance Z0
  // and length x wavelengths which is terminated in a load impedance Z1
  Dim C, S, Z As String
  C = Cx(cos(2*pi*x),0)
  S = Cx(0,sin(2*pi*x))
  Z = cdiv(Z1,Z0)
  return cmul(Z0,cdiv(cadd(cmul(Z,C),S),cadd(C,cmul(S,Z))))
End Function

NetCalc.prefix:
Function prefix(v As Double) As String
  Dim x As Double
  x = Abs(v)
  if x >=1000000 then
    return "M"
  elseif x >=1000 then
    return "k"
  elseif x >= 1   then
    return ""
  elseif x >= 0.001 then
    return "m"
  elseif x >= 0.000001 then
    return "µ"
  elseif x >= 0.000000001 then
    return "n"
  else
    return "p"
  end if
End Function

NetCalc.multiplier:
Function multiplier(v As Double) As Double
  Dim x As Double
  x = Abs(v)
  if x >=1000000 then
    return 0.000001
  elseif x >=1000 then
    return 0.001
  elseif x >= 1   then
    return 1.0
  elseif x >= 0.001 then
    return 1000
  elseif x >= 0.000001 then
    return 1000000
  elseif x >= 0.000000001 then
    return 1000000000
  else
    return 1000000000000
  end if
End Function

NetCalc.LSection:
Sub LSection(omega As Double, R0 As Double, R As Double, X As Double)
  Dim A, B, B2, G, P, X1, X2 As Double
  // The L-section code is based on a PERL program
  // by Claude Frantz <claude@pc0312a.rz.unibw-muenchen.de>
  LS = ""
  A =  R*R + X*X
  G =  R/A
  B =  -X/A
  LS = LS + "Shunt arm parallel to load" + Chr(13)
  P =  1/(G*R0)
  if (P < 1) then
    LS = LS +  "No solution" + Chr(13)
  else
    A =  sqrt(P - 1)
    X1 =  R0*A
    B2 =  -A/(P*R0)
    LS = LS +  "First solution" + Chr(13) + "  Series arm "
    Say(-X1, omega)
    LS = LS + "  Shunt  arm "
    Say(-1/(B2 - B), omega)
    LS = LS +  "Second solution" + Chr(13) +  "  Series arm "
    Say(X1, omega)
    LS = LS + "  Shunt  arm "
    Say(-1/(-B2 - B), omega)
  end if
  
  LS = LS + Chr(13)
  
  LS = LS + "Shunt arm parallel to generator" + Chr(13)
  P = R0/R
  if (P < 1) then
    LS = LS + "No solution" + Chr(13)
  else
    A = sqrt(P - 1)
    X1 = R*A
    X2 = P*R/A
    LS = LS + "First solution" + Chr(13) + "  Series arm "
    Say((-X1 - X), omega)
    LS = LS +  "  Shunt  arm "
    Say(X2, omega)
    LS = LS + "Second solution" + Chr(13) + "  Series arm "
    Say((X1 - X), omega)
    LS = LS + "  Shunt  arm "
    Say(-X2, omega)
  end if
End Sub

NetCalc.Say:
Sub Say(x As Double, omega As Double)
  Dim it As Double
  if Keyboard.OptionKey = true then
    it = x
    LS = LS + "reactance is " + Str(it*multiplier(it)) + prefix(it) + "½" +Chr(13)
  else
    if x < 0 then
      it = -1/(x * omega)
      LS = LS + "capacitance is " + Str(it*multiplier(it)) + prefix(it) + "F" +Chr(13)
    else
      it = x/omega
      LS = LS + "inductance  is " + Str(it*multiplier(it)) + prefix(it) + "H" + Chr(13)
    end if
  end if
End Sub

NetCalc.EnableMenuItems:
Sub EnableMenuItems()
  FilePageSetup.Enabled = true
  AppleAbout.Enabled = true
  Instructions.Enabled = true
End Sub

NetCalc.Close:
Sub Close()
  Quit
End Sub

NetCalc.Open:
Sub Open()
  Dim n As Integer
  pi =4*atan(1)
  INFINITY = "1000000000000,1000000000000"
  UNDEFINED = "NAN,NAN"
  Xs="0,0"
  Ys="0,0"
  Z0s="50,0"
  update
  for n = 0 to 9         // clear memories
    M(n) ="0,0" 
  next
  ImpChart.Show
  me.Show
End Sub

NetCalc.RMenu.Open:
Sub Open()
  me.ListIndex =0
End Sub

NetCalc.RMenu.Change:
Sub Change()
  RMultiplier = 3 * me.ListIndex 
End Sub

NetCalc.LMenu.Open:
Sub Open()
  me.ListIndex =2
End Sub

NetCalc.LMenu.Change:
Sub Change()
  LMultiplier = 3 * me.ListIndex - 12
End Sub

NetCalc.XMenu.Open:
Sub Open()
  me.ListIndex =0
End Sub

NetCalc.XMenu.Change:
Sub Change()
  XMultiplier = 3 * me.ListIndex
End Sub

NetCalc.CMenu.Open:
Sub Open()
  me.ListIndex =0
End Sub

NetCalc.CMenu.Change:
Sub Change()
  CMultiplier = 3 * me.ListIndex - 12
End Sub

NetCalc.FMenu.Open:
Sub Open(Index As Integer)
  me.ListIndex =0
End Sub

NetCalc.FMenu.Change:
Sub Change(Index As Integer)
  FMultiplier = 3 * me.ListIndex 
End Sub

NetCalc.XL.Action:
Sub Action()
   Ys=Xs
   Xs = Cx(gResistance(), 2*pi*gFrequency()*gInductance())
  update
End Sub

NetCalc.XX.Action:
Sub Action()
   Ys=Xs
   Xs = Cx(gResistance(), gReactance())
  update
End Sub

NetCalc.XC.Action:
Sub Action()
   Ys=Xs
   Xs = Cx(gResistance(), -1/(2*pi*gFrequency()*gCapacitance()))
  update
End Sub

NetCalc.XLP.Action:
Sub Action()
  Ys=Xs
  Xs = par(Cx(gResistance(),0), Cx(0,2*pi*gFrequency()*gInductance()))
  update
End Sub

NetCalc.XXP.Action:
Sub Action()
  Ys=Xs
  Xs = par(Cx(gResistance(),0), Cx(0,gReactance()))
  update
End Sub

NetCalc.XCP.Action:
Sub Action()
  Ys=Xs
  Xs = par(Cx(gResistance(),0), Cx(0,-1/(2*pi*gFrequency()*gCapacitance())))
  update
End Sub

NetCalc.E.Action:
Sub Action()
  Dim temp As String
  temp=Xs
  Xs=Ys
  Ys=temp
  update
End Sub

NetCalc.Series.Action:
Sub Action()
    Xs = cadd(Xs, Ys)
    Ys = "0,0"
    update
End Sub

NetCalc.Parallel.Action:
Sub Action()
    Xs =  par(Xs, Ys)
    Ys = "0,0"
    update
End Sub

NetCalc.J.Action:
Sub Action()
  Xs = conj(Xs)
  update
End Sub

NetCalc.Multiply.Action:
Sub Action()
  Dim it as Double
  if Factor.Text = "" then
    beep
  else
    it=Val(Factor.Text)
    Xs=smul(it,Xs)
    update
  end if
End Sub

NetCalc.Divide.Action:
Sub Action()
  Dim it as Double
  if Factor.Text = "" then
    beep
  else
    it=Val(Factor.Text)
    if it = 0 then
      beep
    else
      Xs=sdiv(it,Xs)
      update
    end if
  end if
End Sub

NetCalc.BtnZ0.Action:
Sub Action()
  Z0s=Xs
  update
End Sub

NetCalc.T.Action:
Sub Action()
  Dim Z1,Z0 As String
  Dim x, c, v As Double
  
  Z1 = Xs
  Z0 = Z0s
  x = Val(Length.Text)
    if x >= 1 then    // x in mm
    c = 299792458     // speed of light in m/s
    v = gVelocity()
    x = 0.001*x*gFrequency()/(c*v)
    end if
    Xs = Zin(Z1,Z0,x)
    update
End Sub

NetCalc.C.Action:
Sub Action()
  Xs=Ys
  Ys="0,0"
  update
End Sub

NetCalc.Q.Action:
Sub Action()
  Dim r1,x1 As Double
  r1=Re(Xs)
  x1=Im(Xs)
  
  if r1 = 0 and x1 = 0 then
    Zs = "Q=UNDEFINED"
  else
    if x1 = 0 then
      Zs = "Q=INF"
    else
      Zs="Q=" + Str(Abs(x1 / r1))
    end if
  end if
  Z.Text=Zs
End Sub

NetCalc.BtnX.Action:
Sub Action()
  Dim it As Double
  it = Im(Xs)
  if it >= 0 then
    it = it/(2*pi*gFrequency())
    Zs = "Lx=" + Str(it*multiplier(it)) + prefix(it) + "H"
  else
    it = -1/(2*pi*gFrequency()*it)
    Zs = "Cx=" + Str(it*multiplier(it)) + prefix(it) + "F"
  end if
  it = Im(Parform(Xs))
  if Str(it) <> "INF" then
    if it >= 0 then
      it = it/(2*pi*gFrequency())
      Zs = Zs + " Lp=" + Str(it*multiplier(it)) + prefix(it) + "H"
    else
      it = -1/(2*pi*gFrequency()*it)
      Zs = Zs + " Cp=" + Str(it*multiplier(it)) + prefix(it) + "F"
    end if
  else
     Zs = Zs + "  Xp=INF"
  end if
  Z.Text = Zs
End Sub

NetCalc.L.Action:
Sub Action()
  Dim c As Double
  c = 299792458    // speed of light in m/s
  Zs =  "Length=" + Str(1000*equivLength(Xs,Z0s,gFrequency(),c*gVelocity())) + "mm"
  Z.Text = Zs
End Sub

NetCalc.W.Action:
Sub Action()
  Dim rh As String
  rh = rho (Xs,Z0s)
  Zs="VSWR=" + Str(VSWR(rh)) +" "+"RL=" + Str(ReturnLoss(rh)) + "dB"
  Z.Text=Zs
End Sub

NetCalc.ModX.Action:
Sub Action()
  Zs=Str(modulus(Xs))
  Z.Text=Zs
End Sub

NetCalc.ModN.Action:
Sub Action()
  Zs=Str(modulus(Ns))
  Z.Text=Zs
End Sub

NetCalc.VSWRcircle.Action:
Sub Action()
  Dim rh As String
  Dim modrho As Double
  rh=rho(Xs,Z0s)
  modrho=modulus(rh)
  ImpChart.DrawCircle(modrho)
End Sub

NetCalc.Npoint.Action:
Sub Action()
  Dim rh As String
  rh=rho(Xs,Z0s)
  ImpChart.PlacePoint(Re(rh),Im(rh))
End Sub

NetCalc.CS.Action:
Sub Action()
  ImpChart.Ncircles = 0
  ImpChart.visible = false
End Sub

NetCalc.S.Action:
Sub Action()
  ImpChart.Show
End Sub

NetCalc.Qn.Open:
Sub Open()
  me.ListIndex = 0
End Sub

NetCalc.Qn.Change:
Sub Change()
  Dim n As Integer
  n = me.ListIndex
  if n > 0 then
    Zs = "M("+Str(n)+")= "+M(n)
    Z.Text = Zs
  end if
  me.ListIndex = 0 
End Sub

NetCalc.Rn.Open:
Sub Open()
  me.ListIndex = 0 
End Sub

NetCalc.Rn.Change:
Sub Change()
  Dim n As Integer
  n = me.ListIndex
  if n > 0 then
    Ys = Xs
    Xs = M(n)
    update
  end if
  me.ListIndex = 0 
End Sub

NetCalc.Mn.Open:
Sub Open()
  me.ListIndex = 0 
End Sub

NetCalc.Mn.Change:
Sub Change()
  Dim n As Integer
  n = me.ListIndex
  if n > 0 then
    M(n) = Xs
  end if
  me.ListIndex = 0 
End Sub

NetCalc.LM.Action:
Sub Action()
  Dim R0, omega, R, X As Double
  R0=Re(Z0s)
  omega = 2*pi*gFrequency()
  R=Re(Xs)
  X=Im(Xs)
  LSection(omega, R0, R, X)
  LSections.LSText.Text = LS
  LSections.Show
End Sub

ImpChart.DrawCircle:
Sub DrawCircle(modrho As Double)
  if Ncircles < 100 then
    Xpos(Ncircles) = Xcenter
    Ypos(Ncircles) = Ycenter
    Radius(Ncircles) = round(Scale*modrho)
    Ncircles = Ncircles + 1
  else
    beep
    MsgBox "Too many points or circles"
  end if
  RefreshChart(me.Graphics)
End Sub

ImpChart.PlacePoint:
Sub PlacePoint(r1 As Double, x1 As Double)
  if Ncircles < 100 then
    Xpos(Ncircles) = Xcenter + round(Scale*r1)
    Ypos(Ncircles) = Ycenter + round(Scale*x1)
    Radius(Ncircles) = Psize
    Ncircles = Ncircles + 1
  else
    beep
    MsgBox "Too many points or circles"
  end if
  RefreshChart(me.Graphics)
End Sub

ImpChart.RefreshChart:
Sub RefreshChart(g As Graphics)
  Dim n, r As Integer
  g.TextFont="Helvetica"
  g.Bold=True
  //g.Italic=True
  g.TextSize=10
  SChart(g)                     // Draw the graticule
  g.ForeColor=drawColour 
  for n = 0 to Ncircles -1      // Draw the VSWR circles and rho points
    r = Radius(n)
    g.DrawOval(Xpos(n) - r, Height-Ypos(n) - r, r+r+1, r+r+1)
  next
End Sub

ImpChart.DrawArc:
Sub DrawArc(g As Graphics, X1 As Integer, Y1 As Integer, R As Integer, p1 As Double, p2 As Double)
  Dim n, n1, n2, C, S, C1, S1 As Integer
  Dim p, d As Double
  d = pi/180                   // draw in 1 degree steps
  n1 = Floor( (p2-p1)/d) - 1
  C = X1 + round(R*cos(p1))
  S = Y1 + round(R*sin(p1))
  for n = 1 to n1
    p = p1 +n*d
    C1 = X1 + round(R*cos(p))
    S1 = Y1 + round(R*sin(p))
    g.DrawLine(C,Height-S,C1,Height-S1)
    C = C1
    S = S1
  next
  p = p2
  C1 = X1 + round(R*cos(p))
  S1 = Y1 + round(R*sin(p))
  g.DrawLine(C,Height-S,C1,Height-S1)
End Sub

ImpChart.Rcircles:
Sub Rcircles(g As Graphics)
  Dim n As Integer
  //0(0.05)0.5(0.1)1(0.2)2(0.5)5(2.5)10(5)20(10)50
  for n = 0 to 10
    Rdraw(g, 0.05*n)
  next
  for n = 6 to 10
    Rdraw(g, 0.1*n)
  next
  for n = 6 to 10
    Rdraw(g, 0.2*n)
  next
  for n = 5 to 10
    Rdraw(g, 0.5*n)
  next
  for n = 3 to 4
    Rdraw(g, 2.5*n)
  next
  for n = 3 to 4
    Rdraw(g, 5*n)
  next
  for n = 3 to 5
    Rdraw(g, 10*n)
  next
End Sub

ImpChart.Rdraw:
Sub Rdraw(g As Graphics, r As Double)
  Dim u, v, s As Integer
  if r = 0 or r = 1 or r = 10 then
    g.ForeColor=axisColour
  else
    g.ForeColor=gratColour
  end if
  u = Xcenter + round(Scale*r/(r+1))
  v = Ycenter
  s = round(Scale/(r+1))
  g.DrawOval(u - s, Height-v - s, s+s+1, s+s+1)
  // DrawArc(g, u, v, s, 0, 2*pi)
End Sub

ImpChart.Xcircles:
Sub Xcircles(g As Graphics)
  Dim n As Integer
  //0.05(0.05)0.5(0.1)1(0.2)2(0.5)5(2.5)10(5)20(10)50
  for n = 1 to 10
    Xdraw(g, 0.05*n)
  next
  for n = 6 to 10
    Xdraw(g, 0.1*n)
  next
  for n = 6 to 10
    Xdraw(g, 0.2*n)
  next
  for n = 5 to 10
    Xdraw(g, 0.5*n)
  next
  for n = 3 to 4
    Xdraw(g, 2.5*n)
  next
  for n = 3 to 4
    Xdraw(g, 5*n)
  next
  for n = 3 to 5
    Xdraw(g, 10*n)
  next
End Sub

ImpChart.Xdraw:
Sub Xdraw(g As Graphics, x As Double)
  Dim u, v, s As Integer
  Dim psi As Double
  if x = 1 or x = 10 then
    g.ForeColor=axisColour
  else
    g.ForeColor=gratColour
  end if
  u = Xcenter + Scale
  v = Ycenter + round(Scale/x)
  s = round(Scale/x)
  psi = 1.5*pi - 2*atan(x)
  DrawArc(g, u, v, s, psi, 1.5*pi)
  v = Ycenter - round(Scale/x)
  psi = 0.5*pi + 2*atan(x)
  DrawArc(g, u, v, s, 0.5*pi, psi)
End Sub

ImpChart.Xaxis:
Sub Xaxis(g As Graphics)
  g.ForeColor=axisColour
  g.DrawLine(Xcenter-Scale,Height-Ycenter,Xcenter+Scale,Height-Ycenter)
End Sub

ImpChart.SChart:
Sub SChart(g as Graphics)
  Xcircles(g)
  Rcircles(g)
  Xaxis(g)
  CPoint(g)
  Rscales(g)
  Xscales(g)
  Xdraw(g,1)     // redraw decade lines
  Xdraw(g,10)
End Sub

ImpChart.CPoint:
Sub CPoint(g As Graphics)
  Dim r As Integer
  r = Psize
  g.ForeColor=RGB(255,255,255)
  g.FillOval(Xcenter - r, Height-Ycenter - r, r+r+1, r+r+1)
  g.ForeColor=RGB(0,0,0)
  g.DrawOval(Xcenter - r, Height-Ycenter - r, r+r+1, r+r+1)
  g.DrawLine(Xcenter-1,Height-Ycenter,Xcenter+1,Height-Ycenter)
  g.DrawLine(Xcenter,Height-Ycenter-1,Xcenter,Height-Ycenter+1)
End Sub

ImpChart.Xscales:
Sub Xscales(g As Graphics)
  Dim n As Integer
  //0(0.1)1.0(0.2)2(1)5(5)10(10)20(30)50
  for n = 0 to 10
    Xscale(g, 0.1*n)
  next
  for n = 6 to 10
    Xscale(g, 0.2*n)
  next
  for n = 3 to 5
    Xscale(g, n)
  next
  for n = 1 to 2
    Xscale(g, 10*n)
  next
  Xscale(g, 50)
End Sub

ImpChart.Xscale:
Sub Xscale(g As Graphics, x As Double)
  Dim C, S, w, h As Integer
  Dim r, theta As Double
  Dim t As String
  g.ForeColor=scaleColour
  t = Str(x)
  if x < 10 and x = Floor(x) then
    t = t + ".0"
  end if
  w = g.StringWidth(t)
  r = Scale
  theta = pi - 2*atan(x)
  C = Xcenter + round(r*cos(theta))
  if x < 1 then
    C = C - w
  end if
  if x > 10 then
    C = C + 0.2*w
  end if
  h =round(g.TextHeight/8)
  if x = 0 then
    h = -2*h
  end if
  S = Ycenter + round(r*sin(theta)) + h
  g.DrawString(t, C, Height-S, Scale)
  if x <> 0 then
    h =round(3*g.TextHeight/4)
    S = Ycenter - round(r*sin(theta)) -  h
    g.DrawString(t, C, Height-S, Scale)
  end if
End Sub

ImpChart.Rscales:
Sub Rscales(g As Graphics)
  Dim n As Integer
  //0.1(0.1)0.6(0.2)1,1.4,2(1)3(2)5,10,20,50
  for n = 1 to 6
    Rscale(g, 0.1*n)
  next
  for n = 4 to 5
    Rscale(g, 0.2*n)
  next
  Rscale(g, 1.4)
  for n = 2 to 3
    Rscale(g, n)
  next
  Rscale(g, 5)
  for n = 1 to 2
    Rscale(g, 10*n)
  next
  Rscale(g, 50)
End Sub

ImpChart.Rscale:
Sub Rscale(g As Graphics, r As Double)
  Dim X, Y, w, h As Integer
  Dim t As String
  g.ForeColor=scaleColour
  t = Str(r)
  if r < 10 and r = Floor(r) then
    t = t + ".0"
  end if
  h =round(g.TextHeight/4)
  if r = 1 then
    h = 2*h
  end if
  w = g.StringWidth(t)/2
  X = Xcenter + round(Scale*(r-1)/(r+1)) - w
  Y = Ycenter + h
  g.DrawString(t, X, Height-Y, Scale)
End Sub

ImpChart.DrawEPSfile:
Sub DrawEPSfile()
  Dim f as FolderItem       // input file for graticule
  Dim file As FolderItem    // output file for EPS file
  Dim textInput As TextInputStream
  Dim fileStream as TextOutputStream
  Dim n As Integer
  Dim X, Y, R As Double
  f= GetFolderItem("ImpChart.ps")  // the graticule file
  If Not f.exists then
    Beep
    MsgBox "The file "+f.absolutePath+" doesnÕt exist!"
  else
    file=GetSaveFolderItem("application/text","chart.eps") // the EPS file
    if file <> nil then
      fileStream=file.CreateTextFile    // create or overwrite EPS file
      textInput = f.OpenAsTextFile      // open graticule file
      Do
        fileStream.WriteLine textInput.ReadLine  // copy input to ouput
      Loop Until textInput.EOF
      textInput.Close
      fileStream.WriteLine "lw3 setlinewidth"
      fileStream.WriteLine "newpath"
      for n = 0 to Ncircles -1      // Draw the VSWR circles and rho points
        X = (Xpos(n) - Xcenter)/Scale
        Y = (Ypos(n) - Ycenter)/Scale
        R = Radius(n)/Scale
        fileStream.WriteLine Str(X)+" "+Str(Y)+" "+Str(R)+" 0 360 arc stroke"
      next
      fileStream.WriteLine "grestore"  // finish off the eps file
      fileStream.WriteLine "end"
      fileStream.WriteLine "showpage"
      fileStream.WriteLine "%%Trailer"
      fileStream.WriteLine "%%EOF"
      fileStream.Close
    end if
  end if
Exception err as NilObjectException
  MsgBox "Invalid pathname!"
End Sub

ImpChart.EnableMenuItems:
Sub EnableMenuItems()
  FilePageSetup.Enabled = true
  FilePrint.Enabled = true
  AppleAbout.Enabled = true
  Instructions.Enabled = true
End Sub

ImpChart.Open:
Sub Open()
  pi =4*atan(1)
  Scale = 250
  Psize = 3
  Xcenter = Width / 2
  Ycenter = Height / 2
  printerSettings = ""
End Sub

ImpChart.Chart.Open:
Sub Open()
  Ncircles = 0
End Sub

ImpChart.Chart.Paint:
Sub Paint(g As Graphics)
  axisColour = RGB(64,64,64)
  gratColour = RGB(128,128,128)
  scaleColour = RGB(64,64,64)
  drawColour = RGB(255,0,0)
  RefreshChart(g)
End Sub

ImpChart.CS.Action:
Sub Action()
  Ncircles =0
  Visible = false
End Sub

ImpChart.Print.Action:
Sub Action()
  Dim g as Graphics
  Dim p as PrinterSetup
  p=New PrinterSetup
  if printerSettings <> "" then
    p.SetupString=printerSettings
  else
    If p.PageSetupDialog then
      printerSettings=p.SetupString
    end If
  end if
  g=OpenPrinterDialog(p)
  if g<> Nil then
    axisColour = RGB(0,0,0)
    gratColour = RGB(192,192,192)
    scaleColour = RGB(0,0,0)
    drawColour = RGB(0,0,0)
    RefreshChart(g)
  end if
End Sub

ImpChart.Return.Action:
Sub Action()
  Visible = false
End Sub

ImpChart.EPSFile.Action:
Sub Action()
  DrawEPSfile()
End Sub

AboutBox.AboutBoxOK.Action:
Sub Action()
  Visible = false
End Sub

InfoWindow.EnableMenuItems:
Sub EnableMenuItems()
  FilePageSetup.Enabled = true
  FilePrint.Enabled = true
  AppleAbout.Enabled = true
End Sub

LSections.EnableMenuItems:
Sub EnableMenuItems()
  FilePageSetup.Enabled = true
  AppleAbout.Enabled = true
  Instructions.Enabled = true
End Sub