Qbasicnews.com
June 20, 2019, 04:21:14 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: 2D Hierarchical Editor  (Read 3867 times)
biskbart
New Member

Posts: 13


WWW
« on: February 10, 2006, 03:25:42 PM »

I'm working on a 2D editor that allows to make hierarchical animation
Here's the beginning
Code:

Declare Sub AffNode()
Declare Sub AffLink()
Declare Sub Refresh()
Declare Sub AffMouse ( Forme% , x , y)
Declare Sub AffChaine(X%,Y%,T$,Mode%)
Declare Sub Box(X%,Y%,L%,H%)
Declare Sub BoxR(X%,Y%,L%,H%)
Declare Sub Button(X%,Y%,Text$,Mode%)
Declare Function CreeMenu%(Chaine$,Pere%)
Declare Function GetFree%
Declare Sub AffMenuTexte(Num%,T$)
Declare Sub InitMenu()
Declare Sub TextBox(X%,Y%,Text$,Mode%)
Declare Function PicMenu$(x,y,Num%,SubMenu$)
Declare Function GetInMenu%(Num%,Length%)
Declare Function InZone%(X%,Y%,L%,H%)
Declare Sub SearchObject(Kind As Byte,Number As Integer)

Type Menu : Title As String : Pere As Integer : Libre As Byte : End Type
Const MaxMenu% = 1000 : Dim Shared Menus(1 To MaxMenu%) As Menu : Dim Shared Car%(0 To 255,0 To 256),CarHigh%
CarHigh% = 15
Screen 19,,2

Type Node
     X As Integer
     Y As Integer
     Color As Integer
     Exist As Byte
End Type

Type Cercle
    Node1 As Integer
    Node2 As Integer
    Color As Integer
    Exist As Byte
End Type

Type Link
    Node1 As Integer
    Node2 As Integer
    Length As Integer ' -1 can change
    MinAngle As Integer
    MaxAngle As Integer
    Color As Integer
    Exist As Byte
End Type

Dim Shared Son(0 To 1000) As Node
Dim Shared Links(0 To 1000) As Link
Dim Shared Cercles(0 To 1000) As Cercle
Dim Shared NbNode%, NbLink%, NbCercle%
' Function
Type Fonction
    Title As String
    ShortCut As String
End Type
Dim Shared MaxFunction% : MaxFunction% = 10
Dim Shared Fonctions(1 To MaxFunction%) As Fonction
Dim Shared InFo$

RESTORE Dat1
Cpt%=0
Do
 Read T1$,T2$
 If T1$="" Then Exit Do
 Cpt%=Cpt%+1
 Fonctions(Cpt%).Title=T1$
 Fonctions(Cpt%).ShortCut=T2$
Loop

Dat1:
Data "Put/Move Node","N"
Data "Make Link","L"
Data "Make circle","C"
Data "Erase Node","E"
Data "",""

' End Function
Dim Shared x,y,Forme%, Funct%
NbNode% = 0
NbLink% = 0
Forme% = 0


Dim Shared XMax%, YMax% : SCREENINFO XMax%, YMax%
InitMenu
T$=""
For I%=1 To Cpt%
  T$=T$+Fonctions(I%).Title+" ("+Fonctions(I%).ShortCut+"),"
Next I%
   
Menu$="["+T$+"File[New,Save,Exit]]"

MainMenu% = -1 : Num% = CreeMenu%(Menu$,MainMenu%)
'AffMenuTexte Men%,"" : Sleep
'TextBox 8,8,"Bonjour|comment vas-tu ?|super",2

Type Object
    Kind As Byte
    Number As Integer
End Type
Dim Shared OnObject As Object

SCREENSET 1, 0
SETMOUSE 0, 0, 0
Do
  SearchObject OnObject.Kind,OnObject.Number
  A$= Inkey$
    If A$<>"" Then
     For I%=1 To MaxFunction%
      If Ucase$(A$)=Fonctions(I%).Shortcut Then Funct%=I%
     Next I%
    EndIf
   
 GETMOUSE x, y,, buttons
 If (buttons = 2) Then
    SCREENSET 0, 0
    SETMOUSE x, y, 1
    P$ = PicMenu$(x,y,MainMenu%,"")
    For I%=1 To MaxFunction%
      If P$=Fonctions(I%).Title+" ("+Fonctions(I%).ShortCut+")" Then Funct%=I%
     Next I%
   

    Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
    SCREENSET 1, 0
    SETMOUSE x, y, 0
 EndIf
' On a node ?
 Sel% = -1
 For I%=0 To NbNode% - 1
   If Son(I%).Exist = 1 Then
     Xt%=Son(I%).x
     Yt%=Son(I%).y
     Son(I%).Color = 0
     If x>=Xt%-2 and y>=Yt%-2 and x%<=Xt%+2 and y%<=Yt% + 2 Then Sel%=I%
   EndIf
 Next I%
 If Sel%<>-1 Then Son(Sel%).Color = 1 : Forme% = 2 Else Forme% = 1
 If First% = 1 Then Son(Select1%).Color = 1
' Make Link
 If (buttons and 1) And Sel%<>-1 And (Funct% = 2 Or Funct% = 3) Then
    If First% = 0 Then
      Select1% = Sel%
      Son(Sel%).Color = 1
      First% = 1
      Refresh
      Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
     Else
      If Select1% = Sel% Then
         First% = 0
        Else
         Select Case Funct%
          Case 2
           Links(NbLink%).Node1 = Select1%
           Links(NbLink%).Node2 = Sel%
           Links(NbLink%).Exist = 1
           NbLink%=NbLink%+1
          Case 3
           Cercles(NbCercle%).Node1 = Select1%
           Cercles(NbCercle%).Node2 = Sel%
           Cercles(NbCercle%).Exist = 1
           NbCercle%=NbCercle%+1
         End Select
           Refresh
           Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
           First% = 0
      End If
    End If
 End If
' -> Move Node
 If (buttons and 1) And Sel%<>-1 And Funct% = 1 Then
  Do
   GETMOUSE x, y,, buttons
   Son(Sel%).x = x
   Son(Sel%).y = y
   Refresh
 Loop Until buttons = 0
 End if    
 
 If ucase$(A$)="N" then Funct% = 1 : First% = 0
 If ucase$(A$)="L" then Funct% = 2
' Make node
 If (buttons AND 1) and Funct% = 1 And Sel%=-1 Then
   Son(NbNode%).X = x  
   Son(NbNode%).Y = y
   Son(NbNode%).Exist = 1
   NbNode% = NbNode% + 1
   Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
 End if
 Refresh
 
Loop Until A$=Chr$(27)

Sub SearchObject(Kind As Byte, Number As Integer)
  Info$ = "Mouse on "
  GETMOUSE x, y,, buttons
  For I%=0 To NbNode% - 1
   Xt%=Son(I%).x
   Yt%=Son(I%).y
   ' Son(I%).Color = 0
   If x>=Xt%-2 and y>=Yt%-2 and x%<=Xt%+2 and y%<=Yt% + 2 Then Info$ = Info$ + "Node "+str(I%)+", "
 Next I%
 
 For I%=0 To NbCercle% - 1
   Xt%=Son(Cercles(I%).Node1).x
   Yt%=Son(Cercles(I%).Node1).y
   R# = (Son(Cercles(I%).Node1).x-Son(Cercles(I%).Node2).x)^2+(Son(Cercles(I%).Node1).y-Son(Cercles(I%).Node2).y)^2
   If R#<0.00001 Then R#=0.00001
   R2# = (x-Xt%)^2+(y-Yt%)^2
   If R2#<R# Then Swap R2#,R#
   If R2#/R#<1.1  Then Info$ = Info$ + "Circle "+str(I%)+", " ' Tolerance 1.1 is good !
   'Info$ = Info$ + "Mouse "+str(R2#)+", Rayon :"+str(R#)
 Next I%
 
 For I%=0 To NbLink% - 1
  Xa%=Son(Links(I%).Node1).x : Ya%=Son(Links(I%).Node1).y
  Xb%=Son(Links(I%).Node2).x : Yb%=Son(Links(I%).Node2).y
  Xac%= x-Xa%:Yac%= y-Ya%
  Xbc%= x-Xb%:Ybc%= y-Yb%
  ' Vector product
  Prod% = Abs(Xac% * Ybc% - Yac% * Xbc%)
  In% = 0
  If Sgn(Ybc%) * Sgn(Yac%) <= 0 And Sgn(Xbc%) * Sgn(Xac%) <= 0 Then In%=1
  If Prod%<150 And In%=1 Then Info$ = Info$ + "Link "+str(I%)+", " ' Tolerance 150 is fine !
 
 Next I%
 
End Sub

Sub AffLink
 For I%=0 To NbLink%-1
   If Links(I%).Exist Then Line(Son(Links(I%).Node1).x,Son(Links(I%).Node1).y)-(Son(Links(I%).Node2).x,Son(Links(I%).Node2).y),15
 Next I%
End Sub

Sub AffCircle
 For I%=0 To NbCercle%-1
   If Cercles(I%).Exist Then
    R% = SQR((Son(Cercles(I%).Node1).x-Son(Cercles(I%).Node2).x)^2+(Son(Cercles(I%).Node1).y-Son(Cercles(I%).Node2).y)^2)
    Circle (Son(Cercles(I%).Node1).x,Son(Cercles(I%).Node1).y),R%,15
   End If
 Next I%
 
End Sub

Sub AffNode
 For I%=0 To NbNode%-1
  If Son(I%).Exist Then
   If Son(I%).Color = 0 Then C% = 7 else C% = 14
   Line(Son(I%).x-1,Son(I%).y-1)-step(3,3),C%,b
  EndIf
 Next I%
End Sub

Sub AffMouse ( Forme%, x , y )
 Select Case Forme%
 Case 1
    Line (x-7,y)-step(14,0),15
    Line (x,y-7)-step(0,14),15
 Case 2
    Line (x-3,y-3)-step(6,6),15,b
 End Select
End Sub

Sub Refresh
   CLS
   AffNode
   AffLink
   AffCircle
   AffMouse Forme% , x , y
   ' Locate 24,1 : Print Funct$(Funct%)
   Button 0,YMax%-CarHigh%-10,Fonctions(Funct%).Title + " X :"+str(x)+" ; Y :"+str(y) ,0
   Button 0,0,Info$ ,0
   WAIT &h3DA, 8
   SCREENCOPY
End Sub

Sub InitMenu
    For I%=0 to 255
     Locate 1,1
    If I%<>7 Then Print Chr$(I%):Get (0,0)-(7,CarHigh%),Car%(I%,0)
  Next I%
end sub


Sub AffChaine(X%,Y%,T$,Mode%)
 Select Case Mode%
 Case 1
  For I%=0 To Len(T$)-1
   Put (X%+I%*8,Y%),Car%(Asc(Mid$(T$,I%+1,1)),0),TRANS
  Next I%
 Case 2
  For I%=0 To Len(T$)-1
   Put (X%+I%*8,Y%),Car%(Asc(Mid$(T$,I%+1,1)),0),Alpha
  Next I%
 End Select
End Sub

Function GetInMenu%(Num%,Length%)
 Cpt% = 0
 MaxL% = 0
 For I%=1 to MaxMenu%
   If Menus(I%).Pere = Num% Then
      Cpt% = Cpt% + 1  
      Length% = Len(Menus(I%).Title)
      If Length%>MaxL% Then MaxL% = Length%
    End If  
 Next I%
 Length% = MaxL%
 GetInMenu% = Cpt%
End Function

Function PicMenu$(x%,y%,Num%,SubMenu$)
 Dim TmpMenu$(0 To 100)
 Dim TmpMenu%(0 To 100)
 Length% = 0
 Cpt% = GetInMenu%(Num%, Length%)
 H% = (CarHigh%+4) * Cpt% + 2
 L% = 8 * Length% + 22
 If X%+L%>XMax% Then X% = XMax%-L%-1
 If Y%+H%>YMax% Then Y% = YMax%-H%-1
 Dim Image%(0 To L%*H%+4)
 Get (x%,y%)-Step(L%,H%),Image%
 Box x%,y%,L%,H%
 T% = 0
 For I% = 0 To Cpt%-1
  Do
   If Menus(T%).Pere = Num% Then Exit Do
   T%=T%+1
  Loop
  TmpMenu$(I%)=Menus(T%).Title : TmpMenu%(I%)=T%
  If GetInMenu%(T%,Tmp%)<>0 Then C$=String(Length%-Len(Menus(T%).Title)+1," ")+">" else C$=""
  AffChaine X% + 4,Y% + I% * (CarHigh% + 4 ) + 3,Menus(T%).Title+C$, 1
  T%=T%+1
 Next I%
 SETMOUSE x%+5, y+5%
 OldSel%=-1
 Do
  GETMOUSE x1, y1,, buttons
  If x1>x% And y1>y% and x1<x%+L% And y1<y%+H%-4 Then
   '''''''''''''''''''''''''''''''''''''''''''
   '''''''''''''' Surligner et ouvrir sous menu
    Men% = (y1-Y%-3)\(CarHigh%+2)
    If Men%>Cpt%-1 Then Men%=Cpt%-1
    'If GetInMenu%(TmpMenu%(Men%),Tmp%)<>0 Then C$=String(Length%-Len(TmpMenu$(Men%))+1," ")+">" else C$=String(Length%-Len(TmpMenu$(Men%))+2," ")
   
    If Men%<>OldSel% Then
        If OldSel% <> -1 Then Line(x%+2,y%+2+OldSel%*(CarHigh% + 4))-Step(L%-4,CarHigh%+2),9,B
        BoxR% x%+2,y%+2+Men%*(CarHigh% + 4),L%-4,CarHigh%+2
        OldSel% = Men%
    End If
   
    If buttons = 1 Then
      If GetInMenu%(TmpMenu%(Men%),Tmp%)<>0 Then
        Do : GETMOUSE xt, yt,, buttons : Loop Until buttons = 0
        'If SubMenu$<>"" Then S$ = SubMenu$+">" Else S$ = ""    
        T$ = PicMenu$(x%+L%+1,y%+2+OldSel%*(CarHigh% + 4),TmpMenu%(Men%),SubMenu$+TmpMenu$(Men%)+">")
        If T$<>TmpMenu$(Men%)+">" Then PicMenu$=T$ : Put(x%,y%),Image%,Pset:Erase Image%,TmpMenu%,TmpMenu$ : Exit Function
      Else
        PicMenu$=SubMenu$+TmpMenu$(Men%)
        Put(x%,y%),Image%,Pset:Erase Image%,TmpMenu%,TmpMenu$
        Exit Function
      End If    
    End If
 
    'AffChaine X% + 4,Y% + Men% * (CarHigh% + 2 ) + 3,TmpMenu$(Men%)+C$, 2
  else
   If OldSel%<>-1 Then Line(x%+2,y%+2+OldSel%*(CarHigh% + 4))-Step(L%-4,CarHigh%+2),9,B:OldSel%=-1
   Put(x%,y%),Image%,Pset : Erase Image%,TmpMenu%,TmpMenu$ : exit function
  end if
 Loop
 
End Function

Sub Box(X%,Y%,L%,H%)
 Line(X%,Y%)-Step(L%,H%),9,BF    
 Line(X%,Y%)-Step(L%,H%),15,B
 Line(X%+L%,Y%)-Step(0,H%),0
 Line(X%,Y%+H%)-Step(L%,0),0
End Sub

Function InZone%(X%,Y%,L%,H%)
  GetMouse x1,y1
  If x1>x% and y1>Y% and x1<x%+L% and y1<y%+H% then InZone% = 1 else InZone% = 0
End Function

Sub Button(X%,Y%,Text$,Mode%)
  L% = 8 * Len(Text$) + 10
  Box X%,Y%,L%,CarHigh% + 10
  If Mode% Then BoxR X%,Y%,L%,CarHigh% + 10
  AffChaine$ X%+5,Y%+5,Text$,1
End Sub

Sub TextBox(X%,Y%,Text$,Mode%)
  ' -1 : Center for X% and Y%
  ' Mode 0 : To the left
  ' Mode 1 : Center
  ' Mode 2 : To The rigth
  Dim Ligne$(0 To 50) ' -> It will be enough lol
  MaxL% = 0
  Tmp$ = Text$
  Cpt% = 0
  Do
   A% = Instr(Tmp$,"|")
   If A% = 0 Then Ligne$(Cpt%)=Tmp$ : Exit Do
   Ligne$(Cpt%) = Mid(Tmp$,1,A%-1)
   Tmp$=Mid(Tmp$,A%+1,Len(Tmp$))
   Cpt%=Cpt%+1
  Loop
  For I%=0 To Cpt%
      If Len(Ligne$(I%))>MaxL% Then MaxL% = Len(Ligne$(I%))
  Next I%
  L% = MaxL% * 8 + 10
  H% = 35 + (CarHigh%+2) * (Cpt%+1)
  Dim Image%(0 To L%*H%+4)
  Get (X%,Y%)-Step(L%,H%),Image%
  If X% = -1 Then X% = (XMax% - L%)\2
  If Y% = -1 Then Y% = (YMax% - H%)\2
  Box X%,Y%,L%,H%
  For I%=0 To Cpt%
    T% = Len(Ligne$(I%))
    Select Case Mode%
    Case 0
       AffChaine x% + 5,Y% + 5 + I% * ( CarHigh% + 2 ),Ligne$(I%),1
     Case 1
       AffChaine x% + (L%-(8 * Len(Ligne$(I%))))\2,Y% + 5 + I% * ( CarHigh% + 2 ),Ligne$(I%),1    
     Case 2
       AffChaine x% + L%-(5+8 * Len(Ligne$(I%))),Y% + 5 + I% * ( CarHigh% + 2 ),Ligne$(I%),1    
    End Select
  Next I%
  Tex$="Ok"
  L2% = 8 * Len(Tex$) + 10
  Button X%+(L%-L2%)\2,Y%+H%-CarHigh%-15,Tex$,0
  Do
   GETMOUSE xt, yt,, buttons
   If buttons = 1 And InZone%(X%+(L%-L2%)\2,Y%+H%-CarHigh%-15,L2%,CarHigh%+10) Then
     Button X%+(L%-L2%)\2,Y%+H%-CarHigh%-15,Tex$,1  
     Do : GETMOUSE xt, yt,, buttons : Loop Until buttons = 0
     Exit Do
   EndIf
  Loop
  Put (X%,Y%),Image%,Pset
     
End Sub

Sub BoxR(X%,Y%,L%,H%)
 Line(X%,Y%)-Step(L%,H%),0,B
 Line(X%+L%,Y%)-Step(0,H%),15
 Line(X%,Y%+H%)-Step(L%,0),15
End Sub

Function GetFree%
 Cpt% = 0
 Do
  Cpt%=Cpt%+1  
 Loop Until Menus(Cpt%).Libre = 0
 GetFree% = Cpt%
End Function

Sub AffMenuTexte(Num%,T$)
  For I% = 1 To MaxMenu%
      If Menus(I%).Pere = Num% Then
           Print T$;"|-";Menus(I%).Title';"(";I%;"- Pere : ";Menus(I%).Pere;")"
           AffMenuTexte(I%,T$+"  ")
      Endif
  Next I%
End Sub

Function CreeMenu%(Chaine$,Pere%)
' Print Chaine$:sleep
 
 'Print T$
Do
Label1:
 If Chaine$="[]" Then Exit Function
 A% = INSTR(Chaine$,"[")
 If A%<>1 Then CreeMenu% = -1:Exit Function
 T$ = Mid$(Chaine$,2,Len(Chaine$)-1)
 
 B% = INSTR(T$,"[")
 C% = INSTR(T$,"]")
 D% = INSTR(T$,",")
 If D%<B% Then
  Pere2% = GetFree%
  Menus(Pere2%).Libre = 1
  Menus(Pere2%).Pere = Pere%
  Menus(Pere2%).Title = Mid(T$,1,D%-1)
  Chaine$="["+Mid(T$,D%+1)
  Goto Label1    
 End If%
 If B%<> 0 Then
  ' We get the end of the menu
  Cpt% = 0
  '? T$; Len(T$): Sleep
  CloseT% = 0
  For I%=1 To Len(T$)
     
     C$= Mid(T$,I%,1)
   '  ? C$;I% ; Cpt% ; Ex% : sleep
     If C$="[" Then Cpt%=Cpt%+1
     If C$="]" Then Cpt%=Cpt%-1: CloseT% = 1
     If Cpt% = 0 And CloseT% = 1 Then Ex% = I% : Exit For
     
   '  If Cpt% = 0 Then ? I%:Exit For
  Next I%
   Pere2% = GetFree%
   Menus(Pere2%).Libre = 1
   Menus(Pere2%).Pere = Pere%
   Menus(Pere2%).Title = Mid(T$,1,B%-1)
   
   ' Menus(Pere2%).Title
   If Cpt% = 0 And CloseT% = 1 Then
     SsChaine$=Mid(T$,B%,Ex%-B%+1)
     
     Chaine$="["+Mid(Chaine$,Ex%+3,Len(Chaine$))
     ' ? Mid(T$,1,B%-1);" | ";SsChaine$; " | "; Chaine$:sleep
     CreeMenu%(SsChaine$,Pere2%)
       
     
   EndIf  
  Else
   Chaine2$ = Mid$(T$,1,Len(T$)-1)
  ' ? Chaine2$:sleep
   Do
    A% = Instr(Chaine2$,",")
   
    If Chaine2$="[" Or Chaine2$="[]" Or Chaine2$="" Then Exit Do
    If A%= 0 Then
      Pere2% = GetFree%
      Menus(Pere2%).Libre = 1
      Menus(Pere2%).Pere = Pere%
      Menus(Pere2%).Title = Mid(Chaine2$,1,Len(Chaine2$))  
      Exit Do
    Else
      Pere2% = GetFree%
      Menus(Pere2%).Libre = 1
      Menus(Pere2%).Pere = Pere%
      Menus(Pere2%).Title = Mid(Chaine2$,1,A%-1)  
      Chaine2$ = Mid(Chaine2$,A%+1,Len(Chaine2$))  
    '  ? Chaine2$;"|";Pere%
    End If
    '? Chaine2$ ; sleep
   Loop
   'Chaine$="[]"
   Exit Function
  End If
Loop

 
End Function

Have a Nice day
Biskbart
Logged

iskbart
Anonymous
Guest
« Reply #1 on: February 11, 2006, 02:20:43 AM »

hmmm... what does it do?
Logged
Dio
I hold this place together
*****
Posts: 874



« Reply #2 on: February 11, 2006, 04:49:59 AM »

that's what i was thinking. so far i made neat circles and lines with boxes. and i can't seem to delete nodes. otherwise, pretty cool.
Logged

quote="whitetiger0990"]whitetiger is.. WHITE POWER!!! [/quote]
Here
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #3 on: February 11, 2006, 07:51:41 AM »

Welcome back, Biskbart!

So FreeBasic has made you to come back from the C land?
You disappeared after the last Toshi demo contest back in 2002 and erased your QB site before I could rip all your code Grin

The editor is fun, but all I can do is stretch the lines and circles, I guess there will be some way of fixing its length when the animation comes. A suggestion, use different colors for the links , nodes and circles, now it's a little messy.

Bienvenue!
Logged

Antoni
biskbart
New Member

Posts: 13


WWW
Lol
« Reply #4 on: February 11, 2006, 04:24:23 PM »

You can rip code from here
http://biskbart.free.fr/nouveau/frame.htm
Weel i'm working but slowly because of real life ( i ve got a job , i cannot be a lazy student lol )
I will post my code here each time i can
Cheers
Logged

iskbart
biskbart
New Member

Posts: 13


WWW
New
« Reply #5 on: February 12, 2006, 04:28:15 PM »

You can erase object I'm workin on intersection. It's a bit hard !
Code:

Declare Sub AffNode()
Declare Sub AffLink()
Declare Sub Refresh()
Declare Sub AffMouse ( Forme% , x , y)
Declare Sub AffChaine(X%,Y%,T$,Mode%)
Declare Sub Box(X%,Y%,L%,H%)
Declare Sub BoxR(X%,Y%,L%,H%)
Declare Sub Button(X%,Y%,Text$,Mode%)
Declare Function CreeMenu%(Chaine$,Pere%)
Declare Function GetFree%
Declare Sub AffMenuTexte(Num%,T$)
Declare Sub InitMenu()
Declare Sub TextBox(X%,Y%,Text$,Mode%)
Declare Function PicMenu$(x,y,Num%,SubMenu$)
Declare Function GetInMenu%(Num%,Length%)
Declare Function InZone%(X%,Y%,L%,H%)
Declare Sub SearchObject
Declare Sub DeleteObject(Kind%,Number%)

Type Menu : Title As String : Pere As Integer : Libre As Byte : End Type
Const MaxMenu% = 1000 : Dim Shared Menus(1 To MaxMenu%) As Menu : Dim Shared Car%(0 To 255,0 To 256),CarHigh%
CarHigh% = 15
Screen 19,,2

Type Node
     X As Integer
     Y As Integer
     Color As Integer
     Exist As Byte
     OnObject As Integer
     Number As Integer
End Type

Type Cercle
    Node1 As Integer
    Node2 As Integer
    Color As Integer
    Exist As Byte
End Type

Type Link
    Node1 As Integer
    Node2 As Integer
    Length As Integer ' 0 : can change
    Angle As Integer ' From Another Link |
    FLink As Integer ' Father link       |
    MinAngle As Integer
    MaxAngle As Integer
    Color As Integer
    Exist As Byte
End Type

Dim Shared Son(0 To 1000) As Node
Dim Shared Links(0 To 1000) As Link
Dim Shared Cercles(0 To 1000) As Cercle
Dim Shared NbNode%, NbLink%, NbCercle%
' Function
Type Fonction
    Title As String
    ShortCut As String
End Type
Dim Shared MaxFunction% : MaxFunction% = 10
Dim Shared Fonctions(1 To MaxFunction%) As Fonction
Dim Shared InFo$

RESTORE Dat1
Cpt%=0
Do
 Read T1$,T2$
 If T1$="" Then Exit Do
 Cpt%=Cpt%+1
 Fonctions(Cpt%).Title=T1$
 Fonctions(Cpt%).ShortCut=T2$
Loop

Dat1:
Data "Put/Move Node","N"
Data "Make Link","L"
Data "Make circle","C"
Data "Put Node on Object","P"
Data "Make Link with Length's contraint","M"
Data "Erase Node","E"
Data "",""

' End Function
Dim Shared x,y,Forme%, Funct%
NbNode% = 0
NbLink% = 0
Forme% = 0


Dim Shared XMax%, YMax% : SCREENINFO XMax%, YMax%
InitMenu
T$=""
For I%=1 To Cpt%
  T$=T$+Fonctions(I%).Title+" ("+Fonctions(I%).ShortCut+"),"
Next I%
   
Menu$="["+T$+"File[New,Save,Exit]]"

MainMenu% = -1 : Num% = CreeMenu%(Menu$,MainMenu%)
'AffMenuTexte Men%,"" : Sleep
'TextBox 8,8,"Bonjour|comment vas-tu ?|super",2

Type Object
    Kind As Integer
    Number As Integer
End Type

Dim Shared OnObjet%, OnObject(0 To 50) As Object

SCREENSET 1, 0
SETMOUSE 0, 0, 0
Do
  SearchObject 'OnObject.Kind,OnObject.Number
  A$= Inkey$
    If A$<>"" Then
     For I%=1 To MaxFunction%
      If Ucase$(A$)=Fonctions(I%).Shortcut Then Funct%=I%
     Next I%
    EndIf
   
 GETMOUSE x, y,, buttons
 If (buttons = 2) Then
    SCREENSET 0, 0
    SETMOUSE x, y, 1
    P$ = PicMenu$(x,y,MainMenu%,"")
    For I%=1 To MaxFunction%
      If P$=Fonctions(I%).Title+" ("+Fonctions(I%).ShortCut+")" Then Funct%=I%
     Next I%
   

    Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
    SCREENSET 1, 0
    SETMOUSE x, y, 0
 EndIf
' On a node ?
 Sel% = -1
 For I%=0 To NbNode% - 1
   If Son(I%).Exist = 1 Then
     Xt%=Son(I%).x
     Yt%=Son(I%).y
     Son(I%).Color = 0
     If x>=Xt%-2 and y>=Yt%-2 and x%<=Xt%+2 and y%<=Yt% + 2 Then Sel%=I%
   EndIf
 Next I%
 If Sel%<>-1 Then Son(Sel%).Color = 1 : Forme% = 2 Else Forme% = 1
 If First% = 1 Then Son(Select1%).Color = 1
 If (buttons and 1) And (Funct% = 5 Or Funct% = 6) Then
   Select Case Funct%
     Case 6  
           If OnObjet%>0 Then
            For I%=1 To OnObjet%
     
             DeleteObject OnObject(I%).Kind,OnObject(I%).Number
            Next I%    
           End If
     End Select
 Endif

' Make Link
 If (buttons and 1) And Sel%<>-1 And (Funct% = 2 Or Funct% = 3) Then
    If First% = 0 Then
      Select1% = Sel%
      Son(Sel%).Color = 1
      First% = 1
      Refresh
      Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
     Else
      If Select1% = Sel% Then
         First% = 0
        Else
         Select Case Funct%
          Case 2
           Links(NbLink%).Node1 = Select1%
           Links(NbLink%).Node2 = Sel%
           Links(NbLink%).Exist = 1
           NbLink%=NbLink%+1
          Case 3
           Cercles(NbCercle%).Node1 = Select1%
           Cercles(NbCercle%).Node2 = Sel%
           Cercles(NbCercle%).Exist = 1
           NbCercle%=NbCercle%+1
          Case 4
           Links(NbLink%).Node1 = Select1%
           Links(NbLink%).Node2 = Sel%
           X1% = Son(Links(NbLink%).Node1).x
           Y1% = Son(Links(NbLink%).Node1).y
           X2% = Son(Links(NbLink%).Node2).x
           Y2% = Son(Links(NbLink%).Node2).y
           Length% = SQR((X2%-X1%)^2+(Y2%-Y1%)^2)
           Links(NbLink%).Length=Length%
           Links(NbLink%).Exist = 1
           NbLink%=NbLink%+1
         End Select
         
         Refresh
           Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
           First% = 0
      End If
    End If
 End If
' -> Move Node
 If (buttons and 1) And Sel%<>-1 And Funct% = 1 Then
  Do
   GETMOUSE x, y,, buttons
 ' Length Contrain
'   For I%=0 To NbLinks% - 1
'    N1% = Links(I%).Node1
'    N2% = Links(I%).Node2
'    If Links(I%).Length<>0 And ( N1% = Sel% Or N2%=Sel% ) Then Contrain% = I%:Exit For
'   Next I%
   Son(Sel%).x = x
   Son(Sel%).y = y
   Refresh
 Loop Until buttons = 0
 End if    
 
 If ucase$(A$)="N" then Funct% = 1 : First% = 0
 If ucase$(A$)="L" then Funct% = 2
' Make node
 If (buttons AND 1) and Funct% = 1 And Sel%=-1 Then
   Son(NbNode%).X = x  
   Son(NbNode%).Y = y
   Son(NbNode%).Exist = 1
   Son(NbNode%).OnObject = -1
   NbNode% = NbNode% + 1
   Do : GETMOUSE x, y,, buttons : Loop Until buttons=0
 End if
' Put node on object
 If (buttons AND 1) and Funct% = 4 And Sel%=-1 Then
  If OnObjet% > 1 Then
    SCREENSET 0, 0 : SETMOUSE x, y, 1
    TextBox -1,-1,"Click On One object only",1
    SCREENSET 1, 0 : SETMOUSE x, y, 0
  ElseIf OnObjet% = 0 Then
    SCREENSET 0, 0 : SETMOUSE x, y, 1
   TextBox -1,-1,"Click On One object",1
    SCREENSET 1, 0 : SETMOUSE x, y, 0
  EndIf
 EndIf
 Refresh
 
Loop Until A$=Chr$(27)

Sub SearchObject

  OnObjet% = 0
  Info$ = "Mouse on "
  GETMOUSE x, y,, buttons
  For I%=0 To NbNode% - 1
   Xt%=Son(I%).x
   Yt%=Son(I%).y
   ' Son(I%).Color = 0
   If x>=Xt%-2 and y>=Yt%-2 and x%<=Xt%+2 and y%<=Yt% + 2 And Son(I%).Exist = 1 Then
       Info$ = Info$ + "Node "+str(I%)+", "
       OnObjet%=OnObjet%+1
       OnObject(OnObjet%).Kind = 1
       OnObject(OnObjet%).Number = I%
       
    EndIf
 Next I%
 
 For I%=0 To NbCercle% - 1
  If Cercles(I%).Exist Then
   Cercles(I%).Color = 0
   Xt%=Son(Cercles(I%).Node1).x
   Yt%=Son(Cercles(I%).Node1).y
   R# = (Son(Cercles(I%).Node1).x-Son(Cercles(I%).Node2).x)^2+(Son(Cercles(I%).Node1).y-Son(Cercles(I%).Node2).y)^2
   If R#<0.00001 Then R#=0.00001
   R2# = (x-Xt%)^2+(y-Yt%)^2
   If R2#<R# Then Swap R2#,R#
   If R2#/R#<1.1  Then
      Info$ = Info$ + "Circle "+str(I%)+", " ' Tolerance 1.1 is good !
      Cercles(I%).Color = 1  
      OnObjet%=OnObjet%+1  
      OnObject(OnObjet%).Kind = 3
      OnObject(OnObjet%).Number = I%
     
   End If
  End If
   'Info$ = Info$ + "Mouse "+str(R2#)+", Rayon :"+str(R#)
 Next I%
 
 For I%=0 To NbLink% - 1
  If Links(I%).Exist = 1 Then
  Links(I%).Color = 0
  Xa%=Son(Links(I%).Node1).x : Ya%=Son(Links(I%).Node1).y
  Xb%=Son(Links(I%).Node2).x : Yb%=Son(Links(I%).Node2).y
  Xac%= x-Xa%:Yac%= y-Ya%
  Xbc%= x-Xb%:Ybc%= y-Yb%
  ' Vector product
  Prod% = Abs(Xac% * Ybc% - Yac% * Xbc%)
  In% = 0
  If Sgn(Ybc%) * Sgn(Yac%) <= 0 And Sgn(Xbc%) * Sgn(Xac%) <= 0 Then In%=1
  If Prod%<150 And In%=1 Then
      Links(I%).Color = 1
      Info$ = Info$ + "Link "+str(I%)+", " ' Tolerance 150 is fine !
      OnObjet%=OnObjet%+1
      OnObject(OnObjet%).Kind = 2
      OnObject(OnObjet%).Number = I%
  Endif
 EndIf
 Next I%
End Sub

Sub DeleteObject(Kind%,Number%)
 Select Case Kind%
 Case 1
  Son(Number%).Exist = 0    
  For I%=0 To NbCercle%-1
   If Cercles(I%).Node1 = Number% or Cercles(I%).Node2 = Number% Then
     Cercles(I%).Exist = 0  
   End If
  Next I%
   For I%=0 To NbLink%-1
   If Links(I%).Node1 = Number% or Links(I%).Node2 = Number% Then
     Links(I%).Exist = 0  
   End If
  Next I%
 Case 2
    Links(Number%).Exist = 0
 Case 3
    Cercles(Number%).Exist = 0  
 End Select
End Sub
   
Sub Move(Node%,DecaX%,DecaY%)
  For I%=0 To NbNode%-1
   
  Next I%
End Sub


Sub AffLink
 For I%=0 To NbLink%-1
   If Links(I%).Exist Then Line(Son(Links(I%).Node1).x,Son(Links(I%).Node1).y)-(Son(Links(I%).Node2).x,Son(Links(I%).Node2).y),15-Links(I%).Color
 Next I%
End Sub

Sub AffCircle
 For I%=0 To NbCercle%-1
   If Cercles(I%).Exist Then
    R% = SQR((Son(Cercles(I%).Node1).x-Son(Cercles(I%).Node2).x)^2+(Son(Cercles(I%).Node1).y-Son(Cercles(I%).Node2).y)^2)
    Circle (Son(Cercles(I%).Node1).x,Son(Cercles(I%).Node1).y),R%,15-Cercles(I%).Color
   End If
 Next I%
 
End Sub

Sub AffNode
 For I%=0 To NbNode%-1
  If Son(I%).Exist Then
   If Son(I%).Color = 0 Then C% = 7 else C% = 14
   Line(Son(I%).x-1,Son(I%).y-1)-step(3,3),C%,b
  EndIf
 Next I%
End Sub

Sub AffMouse ( Forme%, x , y )
 Select Case Forme%
 Case 1
    Line (x-7,y)-step(14,0),15
    Line (x,y-7)-step(0,14),15
 Case 2
    Line (x-3,y-3)-step(6,6),15,b
 End Select
End Sub

Sub Refresh
   CLS
   AffNode
   AffLink
   AffCircle
   AffMouse Forme% , x , y
   ' Locate 24,1 : Print Funct$(Funct%)
   Button 0,YMax%-CarHigh%-10,Fonctions(Funct%).Title + " X :"+str(x)+" ; Y :"+str(y)+ " Funct : "+str(Funct%) ,0
   Button 0,0,Info$ ,0
   WAIT &h3DA, 8
   SCREENCOPY
End Sub

Sub InitMenu
    For I%=0 to 255
     Locate 1,1
    If I%<>7 Then Print Chr$(I%):Get (0,0)-(7,CarHigh%),Car%(I%,0)
  Next I%
end sub


Sub AffChaine(X%,Y%,T$,Mode%)
 Select Case Mode%
 Case 1
  For I%=0 To Len(T$)-1
   Put (X%+I%*8,Y%),Car%(Asc(Mid$(T$,I%+1,1)),0),TRANS
  Next I%
 Case 2
  For I%=0 To Len(T$)-1
   Put (X%+I%*8,Y%),Car%(Asc(Mid$(T$,I%+1,1)),0),Alpha
  Next I%
 End Select
End Sub

Function GetInMenu%(Num%,Length%)
 Cpt% = 0
 MaxL% = 0
 For I%=1 to MaxMenu%
   If Menus(I%).Pere = Num% Then
      Cpt% = Cpt% + 1  
      Length% = Len(Menus(I%).Title)
      If Length%>MaxL% Then MaxL% = Length%
    End If  
 Next I%
 Length% = MaxL%
 GetInMenu% = Cpt%
End Function

Function PicMenu$(x%,y%,Num%,SubMenu$)
 Dim TmpMenu$(0 To 100)
 Dim TmpMenu%(0 To 100)
 Length% = 0
 Cpt% = GetInMenu%(Num%, Length%)
 H% = (CarHigh%+4) * Cpt% + 2
 L% = 8 * Length% + 22
 If X%+L%>XMax% Then X% = XMax%-L%-1
 If Y%+H%>YMax% Then Y% = YMax%-H%-1
 Dim Image%(0 To L%*H%+4)
 Get (x%,y%)-Step(L%,H%),Image%
 Box x%,y%,L%,H%
 T% = 0
 For I% = 0 To Cpt%-1
  Do
   If Menus(T%).Pere = Num% Then Exit Do
   T%=T%+1
  Loop
  TmpMenu$(I%)=Menus(T%).Title : TmpMenu%(I%)=T%
  If GetInMenu%(T%,Tmp%)<>0 Then C$=String(Length%-Len(Menus(T%).Title)+1," ")+">" else C$=""
  AffChaine X% + 4,Y% + I% * (CarHigh% + 4 ) + 3,Menus(T%).Title+C$, 1
  T%=T%+1
 Next I%
 SETMOUSE x%+5, y+5%
 OldSel%=-1
 Do
  GETMOUSE x1, y1,, buttons
  If x1>x% And y1>y% and x1<x%+L% And y1<y%+H%-4 Then
   '''''''''''''''''''''''''''''''''''''''''''
   '''''''''''''' Surligner et ouvrir sous menu
    Men% = (y1-Y%-3)\(CarHigh%+2)
    If Men%>Cpt%-1 Then Men%=Cpt%-1
    'If GetInMenu%(TmpMenu%(Men%),Tmp%)<>0 Then C$=String(Length%-Len(TmpMenu$(Men%))+1," ")+">" else C$=String(Length%-Len(TmpMenu$(Men%))+2," ")
   
    If Men%<>OldSel% Then
        If OldSel% <> -1 Then Line(x%+2,y%+2+OldSel%*(CarHigh% + 4))-Step(L%-4,CarHigh%+2),9,B
        BoxR% x%+2,y%+2+Men%*(CarHigh% + 4),L%-4,CarHigh%+2
        OldSel% = Men%
    End If
   
    If buttons = 1 Then
      If GetInMenu%(TmpMenu%(Men%),Tmp%)<>0 Then
        Do : GETMOUSE xt, yt,, buttons : Loop Until buttons = 0
        'If SubMenu$<>"" Then S$ = SubMenu$+">" Else S$ = ""    
        T$ = PicMenu$(x%+L%+1,y%+2+OldSel%*(CarHigh% + 4),TmpMenu%(Men%),SubMenu$+TmpMenu$(Men%)+">")
        If T$<>TmpMenu$(Men%)+">" Then PicMenu$=T$ : Put(x%,y%),Image%,Pset:Erase Image%,TmpMenu%,TmpMenu$ : Exit Function
      Else
        PicMenu$=SubMenu$+TmpMenu$(Men%)
        Put(x%,y%),Image%,Pset:Erase Image%,TmpMenu%,TmpMenu$
        Exit Function
      End If    
    End If
 
    'AffChaine X% + 4,Y% + Men% * (CarHigh% + 2 ) + 3,TmpMenu$(Men%)+C$, 2
  else
   If OldSel%<>-1 Then Line(x%+2,y%+2+OldSel%*(CarHigh% + 4))-Step(L%-4,CarHigh%+2),9,B:OldSel%=-1
   Put(x%,y%),Image%,Pset : Erase Image%,TmpMenu%,TmpMenu$ : exit function
  end if
 Loop
 
End Function

Sub Box(X%,Y%,L%,H%)
 Line(X%,Y%)-Step(L%,H%),9,BF    
 Line(X%,Y%)-Step(L%,H%),15,B
 Line(X%+L%,Y%)-Step(0,H%),0
 Line(X%,Y%+H%)-Step(L%,0),0
End Sub

Function InZone%(X%,Y%,L%,H%)
  GetMouse x1,y1
  If x1>x% and y1>Y% and x1<x%+L% and y1<y%+H% then InZone% = 1 else InZone% = 0
End Function

Sub Button(X%,Y%,Text$,Mode%)
  L% = 8 * Len(Text$) + 10
  Box X%,Y%,L%,CarHigh% + 10
  If Mode% Then BoxR X%,Y%,L%,CarHigh% + 10
  AffChaine$ X%+5,Y%+5,Text$,1
End Sub

Sub TextBox(X%,Y%,Text$,Mode%)
  ' -1 : Center for X% and Y%
  ' Mode 0 : To the left
  ' Mode 1 : Center
  ' Mode 2 : To The rigth
  Dim Ligne$(0 To 50) ' -> It will be enough lol
  MaxL% = 0
  Tmp$ = Text$
  Cpt% = 0
  Do
   A% = Instr(Tmp$,"|")
   If A% = 0 Then Ligne$(Cpt%)=Tmp$ : Exit Do
   Ligne$(Cpt%) = Mid(Tmp$,1,A%-1)
   Tmp$=Mid(Tmp$,A%+1,Len(Tmp$))
   Cpt%=Cpt%+1
  Loop
  For I%=0 To Cpt%
      If Len(Ligne$(I%))>MaxL% Then MaxL% = Len(Ligne$(I%))
  Next I%
  L% = MaxL% * 8 + 10
  H% = 35 + (CarHigh%+2) * (Cpt%+1)
  Dim Image%(0 To L%*H%+4)
  Get (X%,Y%)-Step(L%,H%),Image%
  If X% = -1 Then X% = (XMax% - L%)\2
  If Y% = -1 Then Y% = (YMax% - H%)\2
  Box X%,Y%,L%,H%
  For I%=0 To Cpt%
    T% = Len(Ligne$(I%))
    Select Case Mode%
    Case 0
       AffChaine x% + 5,Y% + 5 + I% * ( CarHigh% + 2 ),Ligne$(I%),1
     Case 1
       AffChaine x% + (L%-(8 * Len(Ligne$(I%))))\2,Y% + 5 + I% * ( CarHigh% + 2 ),Ligne$(I%),1    
     Case 2
       AffChaine x% + L%-(5+8 * Len(Ligne$(I%))),Y% + 5 + I% * ( CarHigh% + 2 ),Ligne$(I%),1    
    End Select
  Next I%
  Tex$="Ok"
  L2% = 8 * Len(Tex$) + 10
  Button X%+(L%-L2%)\2,Y%+H%-CarHigh%-15,Tex$,0
  Do
   GETMOUSE xt, yt,, buttons
   If buttons = 1 And InZone%(X%+(L%-L2%)\2,Y%+H%-CarHigh%-15,L2%,CarHigh%+10) Then
     Button X%+(L%-L2%)\2,Y%+H%-CarHigh%-15,Tex$,1  
     Do : GETMOUSE xt, yt,, buttons : Loop Until buttons = 0
     Exit Do
   EndIf
  Loop
  Put (X%,Y%),Image%,Pset
     
End Sub

Sub BoxR(X%,Y%,L%,H%)
 Line(X%,Y%)-Step(L%,H%),0,B
 Line(X%+L%,Y%)-Step(0,H%),15
 Line(X%,Y%+H%)-Step(L%,0),15
End Sub

Function GetFree%
 Cpt% = 0
 Do
  Cpt%=Cpt%+1  
 Loop Until Menus(Cpt%).Libre = 0
 GetFree% = Cpt%
End Function

Sub AffMenuTexte(Num%,T$)
  For I% = 1 To MaxMenu%
      If Menus(I%).Pere = Num% Then
           Print T$;"|-";Menus(I%).Title';"(";I%;"- Pere : ";Menus(I%).Pere;")"
           AffMenuTexte(I%,T$+"  ")
      Endif
  Next I%
End Sub

Function CreeMenu%(Chaine$,Pere%)
' Print Chaine$:sleep
 
 'Print T$
Do
Label1:
 If Chaine$="[]" Then Exit Function
 A% = INSTR(Chaine$,"[")
 If A%<>1 Then CreeMenu% = -1:Exit Function
 T$ = Mid$(Chaine$,2,Len(Chaine$)-1)
 
 B% = INSTR(T$,"[")
 C% = INSTR(T$,"]")
 D% = INSTR(T$,",")
 If D%<B% Then
  Pere2% = GetFree%
  Menus(Pere2%).Libre = 1
  Menus(Pere2%).Pere = Pere%
  Menus(Pere2%).Title = Mid(T$,1,D%-1)
  Chaine$="["+Mid(T$,D%+1)
  Goto Label1    
 End If%
 If B%<> 0 Then
  ' We get the end of the menu
  Cpt% = 0
  '? T$; Len(T$): Sleep
  CloseT% = 0
  For I%=1 To Len(T$)
     
     C$= Mid(T$,I%,1)
   '  ? C$;I% ; Cpt% ; Ex% : sleep
     If C$="[" Then Cpt%=Cpt%+1
     If C$="]" Then Cpt%=Cpt%-1: CloseT% = 1
     If Cpt% = 0 And CloseT% = 1 Then Ex% = I% : Exit For
     
   '  If Cpt% = 0 Then ? I%:Exit For
  Next I%
   Pere2% = GetFree%
   Menus(Pere2%).Libre = 1
   Menus(Pere2%).Pere = Pere%
   Menus(Pere2%).Title = Mid(T$,1,B%-1)
   
   ' Menus(Pere2%).Title
   If Cpt% = 0 And CloseT% = 1 Then
     SsChaine$=Mid(T$,B%,Ex%-B%+1)
     
     Chaine$="["+Mid(Chaine$,Ex%+3,Len(Chaine$))
     ' ? Mid(T$,1,B%-1);" | ";SsChaine$; " | "; Chaine$:sleep
     CreeMenu%(SsChaine$,Pere2%)
       
     
   EndIf  
  Else
   Chaine2$ = Mid$(T$,1,Len(T$)-1)
  ' ? Chaine2$:sleep
   Do
    A% = Instr(Chaine2$,",")
   
    If Chaine2$="[" Or Chaine2$="[]" Or Chaine2$="" Then Exit Do
    If A%= 0 Then
      Pere2% = GetFree%
      Menus(Pere2%).Libre = 1
      Menus(Pere2%).Pere = Pere%
      Menus(Pere2%).Title = Mid(Chaine2$,1,Len(Chaine2$))  
      Exit Do
    Else
      Pere2% = GetFree%
      Menus(Pere2%).Libre = 1
      Menus(Pere2%).Pere = Pere%
      Menus(Pere2%).Title = Mid(Chaine2$,1,A%-1)  
      Chaine2$ = Mid(Chaine2$,A%+1,Len(Chaine2$))  
    '  ? Chaine2$;"|";Pere%
    End If
    '? Chaine2$ ; sleep
   Loop
   'Chaine$="[]"
   Exit Function
  End If
Loop

 
End Function
Logged

iskbart
axipher
Ancient Guru
****
Posts: 544



« Reply #6 on: February 12, 2006, 05:16:55 PM »

You've got something here, I'd really like to see which direction it goes in.  Props to you man. Cheesy
Logged
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!