Code: Select all
Screen 19
Declare Sub main(As Any Ptr)
Function Linear( Byval x As Double ) As Double
Return x
End Function
Function Quadratic( Byval x As Double ) As Double
Return x * x
End Function
Function Sinusoidal( Byval x As Double ) As Double
Return Sin(x)
End Function
Sub readkey(x As Long,y As Long,st As String,message As String,clr As Ulong)
Dim As String i=""
Static As String j,blink
Var c=Color
i=Inkey
If Left(i,1)=Chr(08) Then j=Mid(j,1,Len(j)-1)
Select Case Left(i,1)
Case Chr(0) To Chr(254)
If Left(i,1)<>Chr(08) Then
j=j+Left(i,1)
End If
End Select
If Frac(Timer)>.5 Then blink=" " Else blink="_"
If Left(i,1)=Chr(27) Then j=""
If i<>Chr(13) Then
Locate x,y,0
Color clr
Print st & j & blink
Color c
Else
j=Rtrim(j,Chr(13))
message=j
j=""
End If
End Sub
Sub server(Listen As Any Ptr)
Dim As String message
dim As Single x
dim As zstring * 20 s="Async callback demo "
If listen=@readkey Then
Do
Window
x+=.2
If x>800 Then x=0
Screenlock
Cls
Draw String(x,300),s
Draw String(x-800,300),s
Cast(Sub(As Long,As Long,As String,As String,As Ulong),Listen) _
(3,3,"Enter (L)inear, (Q)uadratic (S)inusoidal (or exit to end) ",message,3)
Select Case message
Case "L","l"
main(@linear)
print "linear"
Case "Q","q"
main(@quadratic)
print "quadratic"
Case "S","s"
main(@sinusoidal)
print "sinusiodal"
Case "exit"
Exit sub
Case Else
If Len(message) Then Print " " +message+" <-- wot's this?"
End Select
Screenunlock
Sleep 1
Loop
Else
'complete a callback
Window (-15,-10)-(15,10)
Dim As Function(As Double) As Double d=listen
Pset( -15, d(-15) )
For x As Double = -15 To 15 Step 0.1
Line -( x, d(x) )
Next x
End If
End Sub
Sub main(p As Any Ptr)
server(p)
End Sub
main(@readkey)