Type thread
handle As Any Ptr
arrow As String Ptr
End Type
Type mousedata
x As Integer
y As Integer
button As Integer
wheel As Integer
activity As Integer
cursor As Integer
trueth As Integer
End Type
Declare Sub sum OverLoad (x As String Ptr)
Declare Sub mti OverLoad (x As string Ptr)
Declare Function sum OverLoad (x As String, y As String) As String
Declare Function mti OverLoad (x As String, y As String) As String
Declare Function quo (x As String, y As String) As String
Declare Function com (x As String, y As String) As Integer
Declare Function eas (x As String) As String
Declare Function st0 (x As String, y As String) As String Ptr
Declare Function TCr (p As Sub Ptr, x As String, y As String) As thread
Declare Sub drb (ByRef x As String, ByRef k As Integer, ByRef d As String, ByRef d0 As String, ByRef d1 As String)
Declare Sub cursor_picture_set () Constructor
Declare Sub mouse_initialization () Constructor
Declare Function compute (st1 As String, st2 As String, action As Integer) As String
Declare Function editor As String
Declare Function button (x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String) As Integer
Declare Sub trigger (ByRef trig As Integer, x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String)
Declare Sub mousec OverLoad()
Declare Sub mousec OverLoad(comm As integer)
Declare Sub changescreen ()
Dim Shared As String buffer(1 To 8)
Dim Shared mouse As mousedata
Dim Shared sc_da As Integer
Dim Shared cursors(1 To 5, 1 To 50, 1 To 50) As Double
Dim As String st1, st2, st3
Dim As Integer tr1
ScreenRes 1024, 768, 32, 3
Do
'trigger(b1, 100, 300, 300, 100, IIf(b1, "on", "off"), "trigger")
If button (50, 400, 250, 30, st1, "edit number")=2 Then st1=editor
If button (350, 400, 250, 30, st2, "edit number")=2 Then st2=editor
If button (650, 400, 250, 30, st3, "compute")=2 Then st3=compute (st1, st2, tr1)
If button (700, 700, 100, 30, "exit", "exit program")=2 Then Exit Do
trigger (tr1, 400, 500, 150, 50, IIf(tr1, "multiplication", "adding"), "operation")
mousec()
changescreen()
Loop
End
Sub sum OverLoad (p As String Ptr)
Dim As String x, y, s, com0
Dim As Integer lens, i, tt, t, k=1, kk=1
x=Left(*p, InStr(*p, " ")-1)
y=Right(*p, Len(*p)-InStr(*p, " "))
k=k+(Mid(x, 1, 1)="-")*2: kk=kk+(Mid(y, 1, 1)="-")*2
If k=-1 Then x=Right(x, Len(x)-1)
If kk=-1 Then y=Right(y, Len(y)-1)
If k=-1 And kk=1 Then Swap k, kk: Swap x, y
If k=-1 And kk=-1 Then com0="-": k=1: kk=1
If kk=-1 And k=1 Then
If Not com(x, y) Then Swap x, y: com0="-"
EndIf
If Len(x)>Len(y) Then lens=Len(x)+1 Else lens=Len(y)+1
For i=0 To lens-1
If i<=Len(x) And i<=Len(y) Then
tt=Val(Mid(x, Len(x)-i, 1))*k+Val(Mid(y, Len(y)-i, 1))*kk+t
Else
If i>Len(x) And i>Len(y) Then tt=t
If i>Len(x) Then tt=Val(Mid(y, Len(y)-i, 1))*kk+t
If i>Len(y) Then tt=Val(Mid(x, Len(x)-i, 1))*k+t
EndIf
t=(tt-(tt Mod 10))/10
If tt<0 Then tt=10+tt: t=-1
s=Str(tt Mod 10)+s
Next
While Mid(s, 1, 1)="0" And Len(s)>1
s=Right(s, Len(s)-1)
Wend
If com0="-" And s="0" Then com0=""
Poke String, p, com0+s
End Sub
Function sum OverLoad (x As String, y As String) As String
Dim As String s, com0, d, dd, fd0, fd1, d0, d1, dd0, dd1
Dim As Integer i, t, tt, k=1, kk=1, dp0, dp1
Dim As thread dat (1 To 8)
drb(x, 0, d, d0, d1)
drb(y, 0, dd, dd0, dd1)
dat(1)=TCr(@sum, x, y)
ThreadWait(dat(1).handle)
s=*dat(1).arrow
Poke String, dat(1).arrow, ""
If s="0" Then com0=""
If d="" And dd="" Then Return com0+s
If d<>"" And dd="" Then s=com0+s+"."+d0+"/"+d1: Return s
If dd<>"" And d="" Then s=com0+s+"."+dd0+"/"+dd1: Return s
dat(1)=TCr(@mti, d0, dd1)
dat(2)=TCr(@mti, dd0, d1)
dat(3)=TCr(@mti, d1, dd1)
ThreadWait(dat(1).handle)
ThreadWait(dat(2).handle)
ThreadWait(dat(3).handle)
fd0=sum(*dat(1).arrow, *dat(2).arrow): fd1=*dat(3).arrow
sum=eas(com0+s+"."+fd0+"/"+fd1)
End Function
Function com (x As String, y As String) As Integer
Dim As Integer i, k, kk, com0, t
Dim As String d, dd, d0, dd0, d1, dd1
drb (x, k, d, d0, d1)
drb (y, kk, dd, dd0, dd1)
If k And kk Then com0=-1
If k And Not kk Then t=0: GoTo f
If kk And Not k Then t=-1: GoTo f
If Len(x)>Len(y) Then t=-1: GoTo f
If Len(x)=Len(y) Then
For i=1 To Len(x)
If Val(Mid(x, i, 1))>Val(Mid(y, i, 1)) Then t=-1: GoTo f
Next
EndIf
If d<>"" And dd<>"" Then
Return com(mti(d0,dd1), mti(dd0,d1))
EndIf
If d<>"" And dd="" Then Return -1
If dd<>"" And d="" Then Return 0
f:
If com0 Then t=Not t
com=t
End Function
Sub mti OverLoad (p As String Ptr)
Dim As integer k, kk, i, j, t, tt
Dim As String com0, x, y, s, pr
x=Left(*p, InStr(*p, " ")-1)
y=Right(*p, Len(*p)-InStr(*p, " "))
drb(x, k, "", "", "")
drb(y, kk, "", "", "")
If k<>kk Then com0="-"
For i=Len(y) To 1 Step -1
pr=""
t=0
For j=Len(x) To 1 Step -1
tt=Val(Mid(x, j, 1))*Val(Mid(y, i, 1))+t
pr=Str(tt Mod 10)+pr
t=(tt-(tt Mod 10))/10
Next j
pr=Str(t)+pr
pr=pr+String(Len(y)-i, "0")
s=sum(s, pr)
Next i
Poke String, p, s
End Sub
Function mti (x As String, y As String) As String
Dim As Integer dp0, dp1, k, kk
Dim As String d, dd, com0, s, pr, d0, d1, dd0, dd1
Dim As thread dat (1 To 8)
drb(x, k, d, d0, d1)
If d1="" Then d1="1"
drb(y, kk, dd, dd0, dd1)
If dd1="" Then dd1="1"
If k<>kk Then com0="-"
If d="" And dd="" Then
dat(1)=TCr(@mti, x, y)
ThreadWait(dat(1).handle)
Return com0+*dat(1).arrow
EndIf
dat(1)=TCr(@mti, d1, x)
dat(2)=TCr(@mti, dd1, y)
dat(3)=TCr(@mti, d1, dd1)
ThreadWait(dat(1).handle)
ThreadWait(dat(2).handle)
dat(1)=TCr(@sum, *dat(1).arrow, d0)
dat(2)=TCr(@sum, *dat(2).arrow, dd0)
ThreadWait(dat(1).handle)
ThreadWait(dat(2).handle)
ThreadWait(dat(3).handle)
mti=eas(com0+"0."+mti(*dat(1).arrow, *dat(2).arrow)+"/"+*dat(3).arrow)
End Function
Function quo (x As String, y As String) As String
If com (y, x) Then Return "0."+x+"/"+y
If y="1" then Return x
If x=y Then Return "1"
Dim As Integer i=1, tt
Dim As String t, r
t=Left(x, i)
Do While com (y, t)
i=i+1
t=Left(x, i)
Loop
Do Until Mid(x, i, 1)=""
tt=0
While Mid(t, 1, 1)="0" And Len(t)>1
t=Right(t, Len(t)-1)
Wend
Do Until com (y, t) Or t="0"
t=sum(t, "-"+y)
tt=tt+1
Loop
r=r+Str(tt)
i=i+1
t=t+Mid(x, i, 1)
Loop
While Mid(t, 1, 1)="0" And Len(t)>1
t=Right(t, Len(t)-1)
Wend
If t<>"0" Then r=r+"."+t+"/"+y
quo=r
End Function
Function eas (x As String) As String
Dim As String d, d0, d1, t, tt, i="2", ad
Dim As Integer k
Dim As Double STime
drb(x, k, d, d0, d1)
STime=Timer
Do Until com(d1, d0)
d0=sum(d0, "-"+d1)
ad=sum(ad, "1")
If Timer-STime>2 Then Exit do
Loop
Do Until com (i, d0) Or com (i, d1) Or d1="1" Or d0="1"
t=quo(d0, i): tt=quo(d1, i)
If InStr(t, ".")=0 And InStr(tt, ".")=0 Then d0=t: d1=tt Else i=sum(i, "1")
Loop
if d1="1" Then Return sum(x, mti(d0, d1))
Do Until com(d1, d0)
d0=sum(d0, "-"+d1)
ad=sum(ad, "1")
Loop
x=sum(x, ad)
If k Then x="-"+x
If d0="0" Then Return x
eas=x+"."+d0+"/"+d1
End Function
Sub drb (ByRef x As String, ByRef k As Integer, ByRef d As String, ByRef d0 As String, ByRef d1 As String)
Dim As Integer dp0
k=Mid(x, 1, 1)="-"
dp0=InStr(x, ".")
If dp0=0 Then dp0=Len(x)+1
d=Right(x, Len(x)-dp0)
x=Left(x, dp0-1)
d0=Left(d, InStr(d, "/")-1)
d1=Right(d, Len(d)-InStr(d, "/"))
End Sub
Function st0 (x As String, y As String) As String Ptr
Dim As Integer i
Dim As String Ptr pointer0
For i=1 To 32
If buffer(i)="" Then pointer0=@buffer(i): Exit For
Next
Poke String, pointer0, x+" "+y
st0=pointer0
End Function
Function TCr (p As Sub Ptr, x As String, y As String) As thread
Dim As thread temp
temp.arrow=st0(x, y)
temp.handle=ThreadCreate(p, temp.arrow)
Return temp
End Function
Sub cursor_picture_set () Constructor
Dim As Integer i, j
For i=1 To 50
For j=1 To 50
If Abs(25-i)=3 Or Abs(25-j)=3 Then cursors(1, i, j)=RGB(150, 255, 0)
If Abs(25-i)=3 Or Abs(25-j)=3 Then cursors(2, i, j)=RGB(255, 150, 0)
If Abs(25-i)=3 Or Abs(25-j)=3 Then cursors(3, i, j)=RGB(255, 255, 255)
If Abs(25-i)=5 Or Abs(25-j)=5 Then cursors(3, i, j)=RGB(255, 150, 0)
Next j
Next i
End Sub
Sub mouse_initialization () Constructor
mousec(0)
mouse.cursor=1
End Sub
Sub mousec OverLoad() 'mouse control
Dim As Integer r, i, j
If mouse.button=0 Then mouse.trueth=1 Else mouse.trueth=0
r=GetMouse(mouse.x, mouse.y, mouse.wheel, mouse.button)
If mouse.x=-1 Then
If mouse.activity=-1 Then mousec(1): mouse.activity=0
Else
If mouse.activity=0 Then mousec(0): mouse.activity=-1
For i=1 To 50
For j=1 To 50
If cursors(mouse.cursor, i, j) Then PSet(mouse.x-25+i, mouse.y-25+j), cursors(mouse.cursor, i, j)
Next
Next
EndIf
End Sub
Sub mousec OverLoad(comm As integer) 'windows' cursor set
SetMouse , , comm
End Sub
Sub changescreen () 'screen pages control
ScreenSet sc_da, 1-sc_da
sc_da=1-sc_da
Cls
End Sub
Function button (x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String) As Integer 'button maintenance
Dim As Integer r, tip
Dim As Double col
mouse.cursor=1
If mouse.x>x And mouse.x<x+b_x And mouse.y>y And mouse.y<y+b_y Then
Line (x, y)-(x+b_x, y+b_y), RGB(0, 255, 0), b
r=1
mouse.cursor=2
If mouse.button=1 Then
mouse.cursor=3
Line (x, y)-(x+b_x, y+b_y), RGB(255, 0, 0), b
Line (x-2, y-2)-(x+b_x+2, y+b_y+2), RGB(255, 0, 0), b
r=2
EndIf
Else
Line (x, y)-(x+b_x, y+b_y), RGB(0, 128, 0), b
EndIf
Line (x+15, y-5)-(x+23+Len(st)*8, y+5), RGB(0, 0, 0), bf
If tipst="" Then col=RGB(0, 0, 255) Else col=RGB(255, 255, 255)
If st<>"" Then Draw String (x+20, y-4), st, col
If tipst<>"" And r=1 Then tip=button(mouse.x+3, mouse.y-15, 30+Len(tipst)*8.75, 12, tipst, "")
button=r
End Function
Sub trigger (ByRef trig As Integer, x As Integer, y As Integer, b_x As Integer, b_y As Integer, st As String, tipst As String)
Dim As Integer t
Dim As Double col
col=IIf(trig, RGB(64, 16, 16), RGB(16, 64, 16))
Line (x+10, y+10)-(x+b_x-10, y+b_y-10), col, bf
t=button (x, y, b_x, b_y, st, tipst)
If t=2 And mouse.trueth Then trig=-(1+trig)
End Sub
Function editor As String
Dim As String st=" [Enter]", st_
ScreenSet 1-sc_da, 1-sc_da
Line (300, 340)-(720, 390), RGB(0, 32, 0), bf
SetMouse mouse.x, mouse.y, 1
button (312, 356, 400, 20, st, " ")
Locate 45, 43
Input "", st_
SetMouse mouse.x, mouse.y, 0
editor=st_
End Function
Function compute (st1 As String, st2 As String, action As Integer) As String
Dim As String t
ScreenSet 1-sc_da, 1-sc_da
Line (370, 340)-(654, 390), RGB(0, 32, 0), bf
button (387, 356, 250, 20,"computing... please, wait"," ")
If action=0 Then t=sum (st1, st2) Else t=mti(st1, st2)
Sleep 500
compute=t
End Function