Τρίτη, 17 Ιουλίου 2018

RosettaCode M2000 Interpreter 95 tasks.

J

Δευτέρα, 16 Ιουλίου 2018

Αναθεώρηση 25 (Έκδοση 9.3)

Διορθώθηκε η String$() ή Επαν$()  που είχε "χαλάσει" από την 20η αναθεώρηση.  Επιπλέον προστέθηκε η δυνατότητα χρησης ANSI αλφαριθμητικών (ένα byte o κάθε χαρακτήρας) με τις MID$(), LEFT$(), RIGHT$(), INSTR(), RINSTR().


Locale 1033
\\ str$(a$) return ANSI from UTF16LE using Locale
\\ chr$(a$) read a$ as ANSI and return a UTF16LE
\\ make an 8bit Ansi string
a$=str$("    Hello  ")
Print Len(a$) =5.5 ' 5.5*2 = 11 bytes
b$=string$(a$,3)
Print Len(b$)=16.5 ' 16.5*2=33 bytes
k$=b$+b$
Print len(k$)=33 ' 33*2 = 66 bytes
Print chr$(mid$(a$, 2,1 as byte))
Print chr$(trim$(a$ as byte))+"OK"
For i=1 to Len(a$)*2
Print chr$(mid$(a$, i, 1 as byte)), i
next i
z$=trim$(a$ as byte)
Print chr$(left$(z$, 3 as byte))+"/"+chr$(right$(z$, 2 as byte))
Print chr$(mid$(z$, 3, 2 as byte))="ll"

\\ string$() used for encode to escape codes/ json escape codes
\\ we use format$ to decode from escape codes to normal
N$=String$({"hello there"})
Print N$="\u0022hello there\u0022"
Print format$(N$)={"hello there"}
N$=String$({"hello there"} as json)
Print N$={\"hello there\"}
Print format$(N$)={"hello there"}

\\ We can use String$ to encode/decode UTF8
\\ M$ are in bytes
M$=String$("GREEK == ΕΛΛΗΝΙΚΑ" as UTF8enc)
Print  Len(M$)= 12.5
Print String$(M$ as UTF8dec)="GREEK == ΕΛΛΗΝΙΚΑ"
Print  Len("GREEK == ΕΛΛΗΝΙΚΑ")=17

\\We can use String$ to encode/decode to BASE64
\\ using ,0 we get compact encode
\\ using ,1, 60 we get  6 lead spaces every line, we get linebreak after 60 symbols
M$=String$("GREEK == ΕΛΛΗΝΙΚΑ" as Encode64, 0)
Print Len(M$)=48
Clipboard M$
Print M$="RwBSAEUARQBLACAAPQA9ACAAlQObA5sDlwOdA5kDmgORAw=="
Print String$(M$ as Decode64)
M$=String$("GREEK == ΕΛΛΗΝΙΚΑ" as Encode64, 0,10)
clipboard M$
report m$
Print M$={          RwBSAEUARQBLACAAPQA9ACAAlQObA5sDlwOdA5kDmgORAw==}






Άλλο Παράδειγμα:
Τοπικό 1032
α$=γραφη$("Γιώργος")
β$=γραφη$("ς")
Τύπωσε Θέση(α$, β$ ως ψηφίο)=7
 


Locale 1032
a$=str$("Γιώργος")
b$=str$("ς")
Print Instr(a$, b$ as byte)=7



\\ check rinstr
Search$ = Str$("aetabetAbet")
Keyword$ = Str$("bet")
Print rinstr(Search$, Keyword$ as byte)=9
Print rinstr(Search$, Keyword$, 1 as byte)=9
Print rinstr(Search$, Keyword$, 2 as byte)=5

Search$ = "aetabetAbet"
Keyword$ ="bet"
Print rinstr(Search$, Keyword$,1 )=9
Print rinstr(Search$, Keyword$,2 )=5

\\ now check instr
Search$ = Str$("aetabetAbet")
Keyword$ = Str$("bet")
Print instr(Search$, Keyword$ as byte)=5
Print instr(Search$, Keyword$, 6 as byte)=9
Print instr(Search$, Keyword$, 1 as byte)=5
Search$ = "aetabetAbet"
Keyword$ ="bet"
Print instr(Search$, Keyword$)=5
Print instr(Search$, Keyword$, 6)=9
Print instr(Search$, Keyword$, 1)=5


 Αναζήτησε$ = Γραφή$("aetabetAbet")
τι$ = Γραφή$("bet")
Τύπωσε ΘέσηΔεξιά(Αναζήτησε$, τι$ ως ψηφίο)=9
Τύπωσε ΘέσηΔεξιά(Αναζήτησε$, τι$, 1 ως ψηφίο)=9
Τύπωσε ΘέσηΔεξιά(Αναζήτησε$, τι$, 2 ως ψηφίο)=5

Αναζήτησε$ = "aetabetAbet"
τι$ ="bet"
Τύπωσε ΘέσηΔεξιά(Αναζήτησε$, τι$,1 )=9
Τύπωσε ΘέσηΔεξιά(Αναζήτησε$, τι$,2 )=5

Αναζήτησε$ = Γραφή$("aetabetAbet")
τι$ = Γραφή$("bet")
Τύπωσε Θέση(Αναζήτησε$, τι$ ως ψηφίο)=5
Τύπωσε Θέση(Αναζήτησε$, τι$, 6 ως ψηφίο)=9
Τύπωσε Θέση(Αναζήτησε$, τι$, 1 ως ψηφίο)=5
Αναζήτησε$ = "aetabetAbet"
τι$ ="bet"
Τύπωσε Θέση(Αναζήτησε$, τι$)=5
Τύπωσε Θέση(Αναζήτησε$, τι$, 6)=9
Τύπωσε Θέση(Αναζήτησε$, τι$, 1)=5






Κυριακή, 15 Ιουλίου 2018

Αναθεώρηση 24 'Εκδοση 9.3 Προσθήκη στις Ομάδες (Αντικείμενα)

Σε αυτήν την αναθεώρηση (από 22 πήγαμε στην 24), έγινε μια προσθήκη για τις ομάδες. Μπορούμε να βάζουμε μια ειδική  συνάρτηση Διαγραφή {} ή Remove {} που καλείται για ένα αντικείμενο που μπορεί να είναι σε πίνακα ή σε μεταβλητή, ως αντικείμενο ή ως δείκτης σε αντικείμενο, μέσω της Καθαρό (ή Clear), εφόσον αυτό το αντικείμενο δεν έχει άλλο δείκτη σε αυτό. Ουσιαστικά η Καθαρό ελέγχει αν το αντικείμενο είναι το τελευταίο βάσει του αριθμού δεικτών που το χρησιμοποιούν και αν ναι τότε καλεί την Καθαρό (αν δεν υπάρχει, δεν πειράζει, δεν βγαίνει λάθος). Η Διαγραφή ή Remove δεν μπορεί να κληθεί με άλλο τρόπο. Το πραγματικό όνομα της συνάρτησης δεν είναι το Διαγραφή ή Remove.

Το σύμβολο << στον ορισμό του πίνακα Α() κάνει τον διερμηνευτή να φτιάχνει ένα νέο αντικείμενο για κάθε στοιχείο του Α(). Αν βάζαμε το = αντί του << τότε θα έφτιαχνε ένα νέο αντικείμενο και θα το αντέγραφε σε όλες τις θέσεις του πίνακα.


Global RefAlfa=0
Class Alfa {
      id
      Remove {
            Print "remove"
            RefAlfa--
      }
Class:
      Module Alfa (.id){
            RefAlfa++
      }
}
\\ Try with false
if True then {
      k->Alfa(2)
} ELse K=Alfa(2)
Dim A(10)<<Alfa(Random(10, 100))
Dim A(12)
A(10)->k
A(11)->k
n=each(A())
While n {
      Print A(n^).id
}
Print "RefAlfa="; RefAlfa
n=each(A())
While n {
      Clear A(n^)
}
Print "RefAlfa="; RefAlfa
Clear k

Print "RefAlfa="; RefAlfa


Πιο απλό πρόγραμμα:

Module Global A {
      Global RefAlfa=0
      Class Alfa {
            id
            Remove {
                  Print "Remove"
                  RefAlfa--
            }      
        Class:
            Module Alfa (.id){
                  RefAlfa++
            }
     
      }
      A->Alfa(3)
      z->A
      Print refAlfa
      Clear A
      Print refAlfa
      Clear Z
      Print refAlfa
}
Α

Και σε ελληνικά:

Τμήμα Γενικό βήτα {
      Γενική Μετρητής_Αλφα=0
      Κλάση Άλφα {
            Ένας_Αριθμός
            Διαγραφή {
                  Τύπωσε "Διαγραφή"
                  Μετρητής_Αλφα--
            }      
        Κλάση:
            Τμήμα Άλφα (.Ένας_Αριθμός){
                  Μετρητής_Αλφα++
            }
      }
      α->Αλφα(12345)
      \\ δοκίμασε και με α=Αλφα(12345)
      \\  με α->... η λίστα δείχνει: Μετρητής_Αλφα = 1, ΒΗΤΑ.Α*[Group] δηλαδή το Α είναι δείκτης σε ομάδα
      Λίστα
      \\ με α=... η λίστα δείχνει: Μετρητής_Αλφα = 1, ΒΗΤΑ.Α[Group], ΒΗΤΑ.Α.ΈΝΑΣ_ΑΡΙΘΜΟΣ = 12345
      \\ δηλαδή το α είναι ανοικτό αντικείμενο - συνδεδεμένο με το τμήμα - να γιατί βλέπουμε τη δημόσια Ένας_Αριθμός.
      Τύπωσε Μετρητής_Αλφα=1 ' ok
      \\ φτιάχνουμε έναν δείκτη στο α
      \\ αν το α είναι δείκτης σε κλειστό αντικείμενο, θα έχουμε δείκτη σε κλειστό αντικείμενο, όπως το α->Αλφα(12345)
      \\ αν το α δεν είναι δείκτης, ή είναι δείκτης σε ανοικτό αντικείμενο, τότε το κ θα γίνει δείκτης σε ανοικτό αντικείμενο
      \\ αυτό σημαίνει ότι οι δείκτες είναι "ισχνές αναφορές" και ότι δεν έχουν ισχύ αν τερματίσει αυτό το τμήμα.
      \\ το τελευταίο θα συμβεί με το α=Αλφα(12345).
      κ->α
      Τυπωσε κ=>Ένας_Αριθμός=12345
      \\ βάζουμε στο κ τη κενή ομάδα (θα το κάνει ο διερμηνευτής αυτό, εμείς δίνουμε έναν Μακρύ 32bit, το 0&, μετά το ->)
      κ->0&
      \\ Τώρα μειώθηκε ο αριθμός αναφορών, σε ένα.
      \\ Μόνο η Καθαρό καλεί  τη Διαγραφή
      Καθαρό α ' καλεί την διαγραφή αν είναι ο τελευταίος δείκτης στο αντικείμενο
      Τύπωσε Μετρητής_Αλφα=0
}
Κάλεσε βήτα


Σάββατο, 14 Ιουλίου 2018

Αναθεώρηση 21 (Έκδοση 9.3)

1. Νέα συνάρτηση Δυαδικό.Όχι() ή Binary.Not. Παίρνει ένα ακέραιο 32 bit xωρίς πρόσημο (ή ένα νούμερο ισοδύναμο), και δίνει τον 32 bit χωρίς πρόσημο με αναστροφή όλων των ψηφίων.
Ισχύει το Δυαδικό.Όχι(α)+α=0xFFFFFFFF
 ή
Binary.Not(a)+a=0xFFFFFFFF
Υπάρχει κάτι παρόμοιο, το Δυαδικό.Αντίστροφο(), ή Binary.Neg() το οποίο παίρνει ακέραιο με πρόσημο, τον αναστρέφει ως δυαδικό χωρίς πρόσημο και γυρίζει έναν ακέραιο χωρίς πρόσημο
Ισχύει αυτό:
Δυαδικό.Αντίστροφο(α)+Δυαδικό.Ακέραιο(α)=0xFFFFFFFF
Binary.Neg(a)+uint(a)=0xFFFFFFFF

α=0xFFFFFFFF&   ' Αυτό είναι το -1, δείτε το & στο τέλος, το οποίο δηλώνει ότι είναι σταθερά 32bit, σε δεκαεξαδική μορφή, με πρόσημο.
α=-1221
Τύπωσε Δεκαεξ$(Δυαδικό.Ακέραιο(α))
FFFFFB3B
 
θα δώσει σε δεκαεξαδική μορφή το α, αφού από ακέραιο το μετατρέψει σε δυαδική αναπαράσταση ακέραιου χωρίς πρόσημο (έχει δηλαδή τα ίδια ψηφία).

2. Χρήση του Τοπικού, το κωδικού γλώσσας όταν μετατρέπου αλφαριθμητικά από UTF16LE σε ANSI, και το ανάποδο με τα Γραφή$() και Xar$()  ή Str$() και Chr$()
Στην εξαγωγή αρχείων ANSI ήδη λειτουργούσε η επιλογή του τοπικού, οπότε προστέθηκε και εδώ. Τα παλιά προγράμματα δεν έχουν πρόβλημα συμβατότητας. Το τοπικό ρυθμίζεται και από τις ρυθμίσεις, όταν επιλέγουμε Greek ή Latin, όπου στο Greek θα έχουμε το 1032 και στο Latin το 1033. Υπάρχουν και ως εντολές Greek και Latin. Εκτός από την αλλαγή τοπικού, αυτές βάζουν και τα  μηνύματα των σφαλμάτων και των βασικών διαλόγων στα ελληνικά ή στα αγγλικά ανάλογα.




\\ αν αλλάξουμε το τοπικό σε 1032 θα γραφτεί το peche και όχι το pêche
Τοπικό 1033
α$=γραφή$("pêche")
Τύπωσε Μήκος(α$)*2=5 '  5 Bytes
Τύπωσε Χαρ$(α$)="pêche"
Τύπωσε Μήκος(Χαρ$(α$))*2=10 ' 10 bytes

\\ Φυσικά δεν χρειάζεται το τοπικό όταν γράφουμε κανονικά
α$="pêche"
Τύπωσε Μήκος(α$)*2=10 '  10 Bytes
Τύπωσε α$="pêche"

Τετάρτη, 11 Ιουλίου 2018

Ακολουθία Φιμπονάτσι με μεγάλους ακέραιους.

Ενα πρόγραμμα που δημοσίευσα στο www.rosettacode.org
Δείχνει την ακολουθία Φιμπονάτσι από το 1 έως το 4000. Δουλεύει γρήγορα γιατί αποθηκεύει τις τιμές σε μια Κατάσταση (Inventory). Χωρίς την χρήση του αντικειμένου BigNum δεν θα μπορούσαμε να βγάλουμε πάνω από το 139, ενώ τώρα μπορούμε να δώσουμε όσο θέλουμε το όριο. Το αντικείμενο Bignum  προσθέτει αριθμούς χωρίς όριο ψηφίων! Το πετυχαίνει με την χρήση ενός σωρού τιμών (Stack) όπου κάθε τιμή σε αυτόν έχει 14 ψηφία, εκτός από το τελευταίο που μπορεί να έχει λιγότερα. Το τελευταίο στοιχείο έχει τα πιο σημαντικά νούμερα, ενώ το πρώτο έχει τα πρώτα δεκατέσσερα.
Ο σωρός αυξάνεται καθώς προσθέτουμε περισσότερα ψηφία. Έχουμε ορίσει έναν τελεστή "+" που παίρνει δυο αντικείμενα BigNum και εξάγει ένα άλλο.
Επειδή οι σωροί είναι αντικείμενα με δείκτες, το μέλος a κρατάει δείκτη σε αυτό, και στην αντιγραφή αντιγράφεται ο δείκτης. Έτσι όταν εκτελείται η πρόσθεση, το τρέχον (αριστερά του + αντικείμενο) έχει αντιγραφεί, αλλά ο δείκτης στο σωρό πρέπει να αλλαχθεί και να δείχνει ένα αντίγραφο του σωρού. Αυτό το κάνουμε στην αρχή του κώδικα του τελεστή "+".



Η δομή Class (Κλάση) είναι δυο πράγματα:  Περιέχει έναν ορισμό ομάδας, και είναι ταυτόχρονα και συνάρτηση που επιστρέφει την ομάδα που ορίζει. Η δομή αυτή είναι γενική (δηλαδή τη συνάρτηση μπορούμε να την καλέσουμε από οπουδήποτε), εκτός αν βρίσκεται σε ορισμό ομάδας, οπότε είναι μέλος ομάδας (και αυτή μπορεί να είναι γενική ή τοπική).
Δείτε στον ορισμό ότι υπάρχει μια ετικέτα Class: και η οποία διαχωρίζει τα στοιχεία του ορισμού, με το στοιχεία μετά από αυτήν την ετικέτα να χρησιμοποιούνται μόνο μέσα στην συνάρτηση. Στην επιστροφή της ομάδας από τη συνάρτηση γυρνάνε όλα τα μέλη εκτός από αυτά που δόθηκαν μετά την Class: (ή Κλάση:).
Όταν καλούμε την συνάρτηση BigNum() ο διερμηνευτής φτιάχνει πρώτα την βασική ομάδα, και μετά καλεί το τμήμα (module) με το ίδιο όνομα, με την ιδιαιτερότητα ότι κάθε νέο πράγμα που θα κάνουμε εκεί, για την ομάδα, θα μείνει στην ομάδα, και για το λόγο αυτό λέμε το τμήμα αυτό "κατασκευαστή". Όσες τιμές περάσουμε στην συνάρτηση BigNum() θα πάνε σε αυτό το τμήμα στο σωρό τιμών. Αν αφήσουμε τιμές στο σωρό τιμών στο τμήμα, αυτές θα διαγραφούν μετά την επιστροφή της ομάδας. Εδώ αφήνουμε μόνο ένα αλφαριθμητικό με του χαρακτήρες που δηλώνουν τον μεγάλο αριθμό. Η κατασκευή του εσωτερικού σωρού a, γίνεται σε αυτό το σημείο.

Στη Μ2000 τα ονόματα με κεφαλαία-πεζά δεν ξεχωρίζουν (δηλαδή δεν είναι σημαντικό να διατηρούμε τα κεφαλαία ως κεφαλαία, και τα πεζά ως πεζά στις μεταβλητές και στα τμήματα). Επίσης οι τόνοι αφαιρούνται στα ελληνικά γράμματα, και έτσι ονόματα με ίδια γράμματα με ή χωρίς τόνους αναγνωρίζονται ως ίδια. Σε ετικέτες που χρησιμοποιούμε για διακλαδώσεις, έχει σημασία να κρατάμε ως έχει την ετικέτα (με τους τόνους). Οι ετικέτες μετά την πρώτη αναζήτηση και για όσο τρέχει ένα τμήμα βρίσκονται σε χρόνο Ο(1) με ειδική δομή με πίνακα κατακερματισμού. Τα ονόματα τμημάτων/συναρτήσεων/μεταβλητών επίσης βρίσκονται άμεσα. Ουσιαστικά το μέγεθος των ονομάτων παίζει ρόλο, γιατί μικρό μέγεθος δίνει μικρό χρόνο επιστροφής από την συνάρτηση κατακερματισμού. Ο διερμηνευτής εκτελεί άμεσα (ως κείμενο) το κώδικα, γιατί λόγω του εκπαιδευτικού σκοπού για τον οποίο γράφτηκε, έχει την δυνατότητα να δείχνει τον κώδικα όπως τον εκτελεί. Γράψτε το παρακάτω σε ένα τμήμα έστω Α, με την Σ Α ή Edit a, και μετά την έξοδο από το διορθωτή, με Esc, δώστε αντί για το Α ή a το Δοκιμή Α ή Test a. Η φόρμα ελέγχου έχει τρια αριστερά και τρια δεξιά "πλήκτρα". Τα αριστερά δεν φαίνονται ως πλήκτρα γιατί είναι απλά ενδεικτικά για το ποιο τμήμα τρέχει, ποια εντολή και τη συνέχεια της εντολής. Αν επιλέξουμε τη συνέχεια της εντολής διαδοχικά θα εμφανίζεται πότε ο κώδικας και πότε ο σωρός τιμών (κάθε γραμμή κώδικα βλέπει έναν τρέχον σωρό τιμών).

Class BigNum {
      a=stack
      Function Digits {
            =len(.a)*14-(14-len(str$(stackitem(.a,len(.a)) ,"")))
      }
      Operator "+" (n) {
            \\ we get a copy, but .a is pointer
             \\ we make a copy, and get a new pointer
            .a<=stack(.a)
            acc=0
            carry=0
            const d=100000000000000@
                  k=min.data(Len(.a), len(n.a))
                  i=each(.a, 1,k )
                  j=each(n.a, 1,k)
                  while i, j {
                        acc=stackitem(i)+stackitem(j)+carry
                        carry= acc div d
                        return .a, i^+1:=acc mod d
                  }
                  if len(.a)<len(n.a) Then {
                        i=each(n.a, k+1, -1)
                        while i {
                              acc=stackitem(i)+carry
                              carry= acc div d
                              stack .a {data acc mod d}
                        }
                  } ELse.if len(.a)>len(n.a) Then {
                        i=each(.a, k+1, -1)
                        while i {
                              acc=stackitem(i)+carry
                              carry= acc div d
                              Return .a, i^+1:=acc mod d
                              if carry else exit
                        }     
                  }
                  if carry then stack .a { data carry}
      }
      Function tostring$ {
            if len(.a)=0 then ="0" : Exit
            if len(.a)=1 then =str$(Stackitem(.a),"") : Exit
            document buf$=str$(Stackitem(.a, len(.a)),"")
            for i=len(.a)-1 to 1 {
                  Stack .a {
                        buf$=str$(StackItem(i), "00000000000000")
                  }
            }
            =buf$
      }
      class:
      Module BigNum (s$) {
            s$=filter$(s$,"+-.,")
            if s$<>""  Then {
                  repeat {
                        If len(s$)<14 then Stack .a { Data val(s$) }: Exit
                        Stack .a { Data val(Right$(s$, 14)) }
                        S$=Left$(S$, len(S$)-14)
                  } Until S$=""
            }
      }
}

Inventory K=0:=BigNum("0"),1:=BigNum("1")
fib=Lambda K (x as decimal)-> {
      If Exist(K, x) Then =Eval(K) :Exit
      Ret=If(x>1->Lambda(x-1)+Lambda(x-2), bignum(str$(x,"")))
      Append K, x:=Ret
      =Ret
}
\\ Using this to handle form  refresh by code
Set Fast!
For i=1 to 4000 {
      N=Fib(i)
      Print i
      Print N.tostring$()
      Refresh
}

Τρίτη, 10 Ιουλίου 2018

Αναθεώρηση 20 έκδοση 9.3

Διορθώθηκε ο κώδικας της γλώσσας, είχε μια παράλειψη στη κλήση ελαφριών  γεγονότων (χωρίς χρήση αντικειμένων γεγονότων, τα οποία χρησιμοποιούν λίστα συναρτήσεων, δηλαδή εδώ γίνεται σύνδεση μόνο με μια συνάρτηση). Οταν καλούσαμε το γεγονός ότι φτιάχνονταν στην συνάρτηση εξυπηρέτησης δεν διαγράφονταν, έτσι ναι μεν λειτουργούσε αλλά ξοδεύαμε μνήμη, φτιάχνοντας νέες μεταβλητές σε κάθε κλήση!


Να και ένα πρόγραμμα για να διαβάζει FASTA αρχεία όπως έχει αναρτηθεί εδώ στο rosetta code, αλλά χωρίς χρώμα στο κώδικα, οπότε να εδώ το χρωματισμένο. Το πρόγραμμα έχει γραφτεί με ένα αντικείμενο ως αυτόματη μηχανή που γεννάει γεγονότα, και με αυτά παίρνει και δίνει αποτελέσματα, και τερματίζει κιόλας. Οι συναρτήσεις εξυπηρέτησης γεγονότων καλούνται σαν να είναι κώδικας του τμήματος (module) Checkit. Έτσι έχουμε θέαση σε μεταβλητές του τμήματος. Θα μπορούσαμε να αλλάξουμε τις συναρτήσεις ώστε να διαβάζουν αρχείο και άμεσα να γράφουν άλλο αρχείο για εξαγωγή. Εδώ  έχουμε μια εξομοίωση εισαγωγής από αρχείο, το οποίο γίνεται ως εισαγωγή με το πληκτρολόγιο. Η αλλαγή γραμμής δίνεται με το \n και μπορούμε να το σπάσουμε και αυτό σε δυο εισαγωγές, σε \ και n. Ο λόγος που θέλουμε να γίνεται αυτό είναι ότι η μηχανή μας θέλουμε να δουλεύει με οποιοδήποτε μήκος πακέτου, και αθροιστικά (με όλα τα πακέτα ως ένα πακέτο) να δίνει το ίδιο αποτέλεσμα.



Module CheckIt {
      Class FASTA_MACHINE {
            Events "GetBuffer", "header", "DataLine", "Quit"
      Public:
            Module Run {
                  Const lineFeed$=chr$(13)+chr$(10)
                  Const WhiteSpace$=" "+chr$(9)+chrcode$(160)
                  Def long state=1, idstate=1
                  Def boolean Quit=False
                  Def Buf$, waste$, Packet$
            GetNextPacket:
                        Call Event "Quit", &Quit
                        If Quit then exit
                        Call Event "GetBuffer", &Packet$
                        Buf$+=Packet$
                        If len(Buf$)=0 Then exit
                        On State Goto GetStartIdentifier, GetIdentifier, GetStartData, GetData, GetStartIdentifier2
                        exit
            GetStartIdentifier:
                        waste$=rightpart$(Buf$, ">")
            GetStartIdentifier2:
                        If len(waste$)=0 Then waste$=rightpart$(Buf$, ";") : idstate=2
                        If len(waste$)=0 Then idstate=1 : Goto GetNextPacket ' we have to read more
                        buf$=waste$
                        state=2
            GetIdentifier:
                        If Len(Buf$)=len(lineFeed$) then {
                              if buf$<>lineFeed$ then Goto GetNextPacket
                              waste$=""
                        } Else {
                              if instr(buf$, lineFeed$)=0 then Goto GetNextPacket
                              waste$=rightpart$(Buf$, lineFeed$)
                          }
                        If idstate=2 Then {
                            idstate=1
                            \\ it's a comment, drop it
                            state=1
                            Goto GetNextPacket
                        } Else Call Event "header", filter$(leftpart$(Buf$,lineFeed$), WhiteSpace$)
                        Buf$=waste$
                        State=3
            GetStartData:
                        while left$(buf$, 2)=lineFeed$ {buf$=Mid$(buf$,3)}
                        waste$=Leftpart$(Buf$, lineFeed$)
                        If len(waste$)=0 Then Goto GetNextPacket ' we have to read more
                        waste$=Filter$(waste$,WhiteSpace$)
                        Call Event "DataLine", leftpart$(Buf$,lineFeed$)
                        Buf$=Rightpart$(Buf$,lineFeed$)
                        state=4
            GetData:
                        while left$(buf$, 2)=lineFeed$ {buf$=Mid$(buf$,3)}
                        waste$=Leftpart$(Buf$, lineFeed$)
                        If len(waste$)=0 Then Goto GetNextPacket ' we have to read more
                        If Left$(waste$,1)=";" Then wast$="": state=5 : Goto GetStartIdentifier2
                        If Left$(waste$,1)=">" Then state=1 : Goto GetStartIdentifier
                        waste$=Filter$(waste$,WhiteSpace$)
                        Call Event "DataLine", waste$
                        Buf$=Rightpart$(Buf$,lineFeed$)
                        Goto GetNextPacket
            }     
      }
      Group WithEvents K=FASTA_MACHINE()
      Document Final$, Inp$

      \\ In documents, "="" used for append data. Final$="append this"
      Const NewLine$=chr$(13)+chr$(10)
      Const Center=2
      \\ Event's Functions
      Function K_GetBuffer (New &a$) {
            Input "IN:", a$
            inp$=a$+NewLine$
            while right$(a$, 1)="\" {
                  Input "IN:", b$
                  inp$=b$+NewLine$
                  if b$="" then b$="n"
                  a$+=b$
            }
            a$= replace$("\N","\n", a$)
            a$= replace$("\n",NewLine$, a$)
      }
      Function K_header (New a$) {
            iF Doc.Len(Final$)=0 then {
                  Final$=a$+": "
            } Else Final$=Newline$+a$+": "
      }
      Function K_DataLine (New a$) {
            Final$=a$
      }
      Function K_Quit (New &q) {
            q=keypress(1)
      }
      Cls , 0
      Report Center, "FASTA Format"
      Report "Simulate input channel in packets (\n for new line). Use empty input to exit after new line, or press left mouse button and Enter to quit. Use ; to write comments. Use > to open a title"
      Cls, row ' scroll from current row
      K.Run
      Cls
      Report Center, "Input File"
      Report Inp$
      Report Center, "Output File"
      Report Final$
}
checkit