VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00C0FFFF&
   Caption         =   "Form1"
   ClientHeight    =   6060
   ClientLeft      =   60
   ClientTop       =   390
   ClientWidth     =   10800
   LinkTopic       =   "Form1"
   ScaleHeight     =   6060
   ScaleWidth      =   10800
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim aa$, bb$, a, b, umax, x, v, dt, xlim, f, inkey$

Private Sub Form_KeyPress(KeyAscii As Integer)
inkey$ = Chr$(KeyAscii)
End Sub

Private Sub Form_Load()
'Press key <F2> to see the text contained in the SUBs'



Show
SetFocus
Scale (1.2, -6)-(-1.2, 6)   ' Position range +/-1.2, velocity +/-6

f = 0                        'initial disturbing force, Newtons
cr$ = Chr$(13)
Do
  Cls
'  VIEW                         ' Full screen
  axes                         '
  a = 100: b = 100: umax = 10  ' Velocity gain, position gain, drive limit
                               '              (shaped by curve), newtons
                               '
  'LOCATE 2, 5
  Print "Press number key to change disturbance, return to rerun, space to exit"
  'LOCATE 24, 45:
  Print "Disturbing force = "; f; " N";
  showlimits
  dt = 0.005                   ' Time step of Euler integration
  'LOCATE 17, 1                 ' Print settling times from line 17
                               '
                               ' Now plot curves for various steps
  x = -1.5: v = 0
  doplot

  x = -1: v = 0
  doplot

  x = -1: v = 4
  doplot

  x = 1.5: v = 0
  doplot

  x = 1: v = 0
  doplot

  x = 1: v = -4
  doplot

  bb$ = ""
  Do
     x = 2 * (Rnd - 0.5)
     v = 10 * (Rnd - 0.5)
     doplot
     DoEvents
  Loop Until bb$ = " " Or bb$ = cr$

Loop Until bb$ = " "
End
End Sub

Sub axes()
Line (-1, 0)-(1, 0), vbBlue         ' Horizontal
Line (0, -5)-(0, 5), vbBlue         ' Vertical
'LOCATE 3, 38: Print "+5"       ' Show limits of axes
'LOCATE 14, 6: Print "-1"
'LOCATE 14, 73: Print "+1"
'LOCATE 24, 38: Print "-5";
End Sub

Function clip(c, d)
' Apply symmetric limits for drive constraint or piecewise linear control
'
If Abs(c) > d Then
   clip = d * Sgn(c)
   ForeColor = vbRed
Else: clip = c
   ForeColor = vbBlack
End If
End Function

Function curve(c)
' Shaping for position error feedback signal
        If c < -0.001 Then
           curve = -Sqr(-10 * c)   ' Parabolic to left
        ElseIf c < 0.001 Then
           curve = 100 * c         ' Linear in narrow central region
        Else
           curve = Sqr(10 * c)     ' Parabolic to right
        End If
End Function

Sub doplot()
t = 0
'PRINT "       From x = "; x, "time to 1 mm error = ";
Do
   aa$ = inkey$
   inkey$ = ""
   If aa$ <> "" Then bb$ = aa$     'remember key-press
   If aa$ > " " Then f = (Val(aa$) - 5)        ' New value of disturbance
   PSet (x, v)                               ' Start of line-segment
   u = clip(-a * v - b * curve(x), umax) + f ' f is the disturbance
   v = v + u * dt                            ' Euler step
   x = x + v * dt                            '
   Line -(x, v)                              ' Show movement
   t = t + dt                                ' Update time
Loop Until (Abs(x) < 0.001 And Abs(v) < 0.1) ' Arrived in limits ?
'Color vbBlack
'PRINT USING "##.##"; t; : PRINT " sec"       ' Complete the text
End Sub

Sub showlimits()
u = umax
For i = 1 To 2
   For xx = -1.1 To 1.1 Step 0.01
      PSet (xx, (u - b * curve(xx)) / a)
   Next
   u = -umax
Next
End Sub