Σάββατο 9 Μαρτίου 2019

Αναθεώρηση 8 έκδοση 9.8

Προσθήκη 2-12-2021
Στην Έκδοση 10, υπάρχει στο info αρχείο το τμήμα ΓΛΩΣΣΑ με πιο προχωρημένο κώδικα, με διάφανο τίτλο και μενού (combobox), με χρωματισμό της γραμμής που έχει το δρομέα, με χρώμα επιλεγμένο για την κάθετη μπάρα ολίσθησης (η οποία κρύβεται αυτόματα). Επίσης με μενού αναδυόμενο (popup) στη θέση του δρομέα με δυνατότητα να γράψουμε τον αριθμό γραμμής και να μεταφέρουμε το δρομέα εκεί! Επίσης υπάρχει και ένα Button που λειτουργεί μόνο ως ένδειξη μηνυμάτων δεξιά από το μενού, και δείχνει τη γραμμή και θέση του δρομέα με αριθμούς. Στο μενού επεξεργασία υπάρχει και το άνοιγμα στον διερμηνευτή της γλώσσας (αν είναι εγκατεστημένος, ανοίγει το πρόγραμμα εκεί για εκτέλεση). Στη βοήθεια αλλάζουμε τη προβολή, Μεγάλα ή Μικρά. Επίσης στο παράδειγμα αυτό δείχνω πως αλλάζουμε το μέγεθος γραμμάτων και γραμματοσειρά στον τίτλο της φόρμας! Δείτε επίσης πάνω αριστερά πως έχει μπει εικονίδιο και ότι υπάρχει ένα κουμπί με τρεις γραμμές από όπου δίνουμε εντολές για απόκρυψη (ελαχιστοποίηση) επέκταση (μεγιστοποίηση) και μετακίνηση και αλλαγή μεγέθους με τα πλήκτρα. Το έχω αφήσει επίτηδες έτσι ώστε βλέποντας άλλα προγράμματα μέσα στο Info να μπορεί κανείς να το βελτιώσει, όπως να δει πώς βάζουμε λειτουργία Hover στο μενού, όπου όταν πάμε το δείκτη του ποντικιού πάνω από τα μενού και τα ενεργοποιήσουμε μια φορά, τότε τα μενού ανοίγουν καθώς περνάμε το δείκτη πάνω τους, υπάρχει στο cs τον csharp editor. Επίσης δείτε πώς γίνεται να ορίσουμε Accelerator Keys, υπάρχουν στο mEditor (το οποίο έχει όλα εκτός από το πώς αλλάζουμε τα χρώματα στο EditBox, το οποίο το έχει το cs). Στο info υπάρχουν τέσσερις εκδοχές του NotePad, mEditor (έχει και δεύτερο EditBox για βοήθεια της M2000, κρυφό αρχικά), cs, htmleditor, ΓΛΩΣΣΑ. Το καθένα έχει κάτι διαφορετικό από τα άλλα!





Παλιό Κείμενο (Έκδοση 8, τρέχει και στην 10 - γενικά οι νέες εκδόσεις είναι συμβατές με τις παλιές):
Βελτίωσα τον χρωματιστή κώδικα στο EditBox,
Εδώ είναι το notepad με τις αλλαγές για να χρωματίζει κώδικα σε ΓΛΩΣΣΑ του λυκείου για το μάθημα ΑΕΠΠ.

Σε linux μπορεί κανείς να χρησιμοποιήσει  "DejaVu Sans Mono", 14
Η τελευταία παράμετρος της "FontAttr" είναι τα bold, με true έχουμε bold γράμματα.

\\ notepad
Show
Clear
Flush
Title$="Πρόχειρο Γλώσσας"
Dir User
Title Title$, 0
Declare NotePad Form
Declare Pad EditBox Form NotePad
Declare File1 Combobox Form NotePad
Declare Edit1 Combobox Form NotePad
Declare Help1 Combobox Form NotePad
Method Pad, "FontAttr", "COURIER NEW", 12, false
With Pad, "NoWrap", True, "ColorCollection1", "|ΠΡΟΓΡΑΜΜΑ|ΜΕΤΑΒΛΗΤΕΣ|ΠΡΑΓΜΑΤΙΚΕΣ|ΑΚΕΡΑΙΕΣ|ΛΟΓΙΚΕΣ|ΧΑΡΑΚΤΗΡΕΣ|ΣΤΑΘΕΡΕΣ|ΑΡΧΗ|ΓΡΑΨΕ|ΔΙΑΒΑΣΕ|ΤΕΛΟΣ_ΠΡΟΓΡΑΜΜΑΤΟΣ|DIV|MOD|ΑΝ|ΤΟΤΕ|ΑΛΛΙΩΣ|ΑΛΛΙΩΣ_ΑΝ|ΤΕΛΟΣ_ΑΝ|ΓΙΑ|ΑΠΟ|ΜΕΧΡΙ|ΜΕ_ΒΗΜΑ|ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ|ΕΠΙΛΕΞΕ|ΠΕΡΙΠΤΩΣΗ|ΤΕΛΟΣ_ΕΠΙΛΟΓΩΝ|ΟΣΟ|ΕΠΑΝΑΛΑΒΕ|ΑΡΧΗ_ΕΠΑΝΑΛΗΨΗΣ|ΜΕΧΡΙΣ_ΟΤΟΥ|ΚΑΙ|Η|ΟΧΙ|ΑΛΗΘΗΣ|ΨΕΥΔΗΣ|ΚΑΛΕΣΕ|ΔΙΑΔΙΚΑΣΙΑ|ΤΕΛΟΣ_ΔΙΑΔΙΚΑΣΙΑΣ|Α_Μ(|Α_Τ(|Ε|ΕΦ(|ΗΜ(|ΛΟΓ(|ΣΥΝ(|Τ_Ρ(|ΣΥΝΑΡΤΗΣΗ|ΤΕΛΟΣ_ΣΥΝΑΡΤΗΣΗΣ|", "LineComment1", "!!", "OtherSymbols",",≤≥≠", "CommentSymbols", "!", "ComSymbolsWidth", 1, "WordCharRight", " ,[]+-*/)}≤≥≠"+chr$(9), "WordCharleft", " ,[]+*/({≤≥≠"+chr$(9),  "LineComment2",CHR$(0), "StringSep2","'", "AssignSym","<-"
With File1,"label","Αρχείο", "listtext" As list$, "list" As list$() '
With Edit1,"label","Επεξεργασία",  "Mark", Color(255,100,0)
With Help1,"label","Βοήθεια",  "Mark", Color(255,100,0)
With NotePad, "Title" As Caption$, "Visible" As Visible, "TitleHeight" As tHeight, "Sizable", True
With Pad, "Text" As Pad.Text$, "NoColor", False, "ShowAlways", True, "tabwidth",2
Def TitleStr$(a$)=ucase$(left$(a$,1))+mid$(a$,2)
Filename$=Dir$+"νεο.glo"
Caption$=TitleStr$(File.Name$(Filename$)) +" - ΓΛΩΣΣΑ"
Method NotePad,"move", 2000, 4000, 8000, 4000
Layer NotePad {Cls #FFA000}
With File1,"MenuStyle", True, "MenuWidth", 3000 
With Edit1,"MenuStyle", True, "MenuWidth", 3000 
With Help1,"MenuStyle", True, "MenuWidth", 3000 
With File1, "MenuEnabled" As mEnable()
For This {
 mi$="MenuItem"  \\ is a temporary variable only for For This Block
 Method File1, mi$,"Φόρτωσε",True
 Method File1, mi$,"Σώσε",True
 Method File1, mi$,""    \\  only  a line here
 Method File1, mi$,"Κλείσε",True
 Method File1, mi$,"Έξοδος",True
 
 Method Edit1, mi$,"Αποκοπή",True
 Method Edit1, mi$,"Αντιγραφή",True
 Method Edit1, mi$,"Επικόληση",True
 
 Method Help1, mi$,"Περί",True
}
Document BackUp$=""
Pad.Text$=BackUp$
Function Notepad.Unload {
      Keyboard "!"
}
Function Notepad.Resize {
      Layer NotePad { Cls Color(255, 160, 0) ,0}
      With NotePad, "Width" As NP.Width, "Height" As NP.Height, "TitleHeight" As tHeight
      tHeight1=theight*2
      Method File1,"move", twipsX*2, tHeight,  twipsX*100, tHeight
      Method Edit1,"move", twipsX*2+twipsX*100, tHeight,  twipsX*160, tHeight
      Method Help1,"move", twipsX*2+twipsX*260, tHeight,  twipsX*120, tHeight
      If NP.height>2000 Then {
            Method Pad,"move", twipsX*2, tHeight1,  NP.Width-twipsX*5, NP.Height-tHeight1-twipsx*3
            With Pad, "NoWrap" As NoWrap
            If Not NoWrap Then Method Pad,"Resize"
      }
}
Function Edit1.DblClick {
      Read Local Edit1index
      Select Case Edit1index
      Case 0
            {
            Method Pad,"mn1sub"
            Method Pad,"Resize"
            }
      Case 1
            Method Pad,"mn2sub"
      Case 2
            {
                 Method Pad, "mn3sub"
                 Method Pad,"GetFocus"
                 Method Pad,"Resize"
           }
      End Select
}
Function Pad.PopUp {
      Read Local X, Y
      Method Pad,"PopUpMenu", "",X , Y
}
Function File1.DblClick {
      Read New File1index
      Local cont, cont2, f$, NL$={
      }
      File1index++
      {
      On File1index Goto Open1, Save1, ExitNow, Save2, Unload
      Exitnow:
      Exit
Open1:
      If Pad.Text$<>BackUp$ Then {
            If ask("Save Changes first?",Title$)=1 Then Goto Save1
      }
     Layer NotePad {
           Open.file filename$,"c:\","Φόρτωσε Αρχείο","glo"
     }
     Method Pad,"GetFocus"
     Read f$
     If f$<>"" Then {
           Filename$=f$
           If exist(F$) then {
           Clear BackUp$
           Load.Doc BackUp$, f$
           Caption$=TitleStr$(File.Name$(Filename$)) +" - ΓΛΩΣΣΑ"
           Pad.Text$=BackUp$
           } else Pad.text$="": Clear BackUp$
           Method Pad, "Resize"
      }
      Exit
Save1:
      Layer NotePad {
            Save.As Filename$,"c:\","Σώσε αρχείο","glo"
      }
      if not cont2 then Method Pad,"GetFocus"
      Read f$
      If f$="" Then Exit 
      If lcase$(file.type$(f$))<>"glo" then f$=f$+".glo"
      If Exist(f$) Then  If Ask(NL$+"Overwrite"+NL$+f$,Title$)<>1 Then Exit
      Try ok {
        Clear BackUp$
        BackUp$=Pad.Text$
        Save.Doc BackUp$, f$
        filename$=f$
        Caption$=TitleStr$(File.Name$(Filename$)) +" - M2000 Pad"
      }
     If ok else beep
     If not cont then Exit
Save2:
      cont=True
      If Pad.Text$<>BackUp$ Then {
            If ask("Να σωθούν οι αλλαγές;",Title$)=1 Then Goto Save1
      }
      Clear BackUp$
      Pad.Text$=""
      If Cont2 then {
           Method NotePad, "CloseNow"
           Keyboard "!"  \\ to end the loop
      } Else {
            FileName$=Dir$+"νεο.glo"
            Caption$=TitleStr$(File.Name$(Filename$)) +" - ΓΛΩΣΣΑ"
            Method Pad, "Resize"
      }
      Exit
Unload:
      Cont2=True : Goto Save2
      }
}
Function Help1.DblClick {
      Local A, info$
      Info$={
            Πρόχειρο για συγγραφή προγραμμάτων σε ΓΛΩΣΣΑ για το μάθημα της ΑΕΠΠ
            }
      A=Ask(info$,Title$,"","")


}
Call Local Notepad.Resize()


Method NotePad,"Show" ', 1
Every 1000 {
If inkey$<>"" then exit
}
Declare Pad Nothing
Declare NotePad Nothing 
Print "Τέλος"



Εδώ η εικόνα από τη φόρμα:




Ο κώδικας μπορεί να εξαχθεί με αντιγραφή στο πρόχειρο με το χρώμα:

ΠΡΟΓΡΑΜΜΑ ΑΛΦΑ
ΣΤΑΘΕΡΕΣ
  ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΚΕΛΙΩΝ = 100
  ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΜΠΛΟΚ = 50
ΜΕΤΑΒΛΗΤΕΣ
  ΑΚΕΡΑΙΕΣ: ΠΙΝ[ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΚΕΛΙΩΝ], ΜΠΛΟΚ[ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΜΠΛΟΚ], Ν, Μ
  ΑΚΕΡΑΙΕΣ: Ι, Π, Κ, Λ, Π1
  ΑΚΕΡΑΙΕΣ: ΣΠ[ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΜΠΛΟΚ*2], ΣΚ[ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΜΠΛΟΚ*2], ΣΤΟΙΒΑ
  ΑΚΕΡΑΙΕΣ: ΜΗΚΟΣ[ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΜΠΛΟΚ]
  ΛΟΓΙΚΕΣ: ΣΗΜΑΙΑ
ΑΡΧΗ
  ΑΡΧΗ_ΕΠΑΝΑΛΗΨΗΣ
    ΓΡΑΨΕ "ΔΩΣΕ ΑΡΙΘΜΟ ΚΕΛΙΩΝ:"
    ΔΙΑΒΑΣΕ Ν
  ΜΕΧΡΙΣ_ΟΤΟΥ Ν > 0 ΚΑΙ Ν <= ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΚΕΛΙΩΝ
  ΑΡΧΗ_ΕΠΑΝΑΛΗΨΗΣ
    ΓΡΑΨΕ "ΔΩΣΕ ΑΡΙΘΜΟ ΜΠΛΟΚ"
    ΔΙΑΒΑΣΕ Μ
  ΜΕΧΡΙΣ_ΟΤΟΥ Μ >= 0 ΚΑΙ Μ <= ΜΕΓΙΣΤΟ_ΠΛΗΘΟΣ_ΜΠΛΟΚ
  ΜΗΚΟΣ[1] <- 0
  ΑΝ Μ > 0 ΤΟΤΕ
    ΓΙΑ Ι ΑΠΟ 1 ΜΕΧΡΙ Μ
      ΓΡΑΨΕ "ΜΕΓΕΘΟΣ ΜΠΛΟΚ:", Ι
      ΔΙΑΒΑΣΕ ΜΠΛΟΚ[Ι]
    ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
    ΜΗΚΟΣ[Μ] <- ΜΠΛΟΚ[Μ]
    ΑΝ Μ > 1 ΤΟΤΕ
      ΓΙΑ Ι ΑΠΟ Μ - 1 ΜΕΧΡΙ 1 ΜΕ_ΒΗΜΑ -1
        ΜΗΚΟΣ[Ι] <- ΜΠΛΟΚ[Ι] + ΜΗΚΟΣ[Ι + 1] + 1
      ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
    ΤΕΛΟΣ_ΑΝ
  ΤΕΛΟΣ_ΑΝ
  ΑΝ ΜΗΚΟΣ[1] > Ν ΤΟΤΕ
    ΓΡΑΨΕ "ΑΔΥΝΑΤΟΝ"
  ΑΛΛΙΩΣ_ΑΝ Μ = 0 ΤΟΤΕ
    ΓΙΑ Ι ΑΠΟ 1 ΜΕΧΡΙ Ν
      ΓΡΑΨΕ 0, "  "
    ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
    ΓΡΑΨΕ
  ΑΛΛΙΩΣ
    ΣΤΟΙΒΑ <- 0
    Π1 <- 0
    Λ <- 0
    ΟΣΟ Π1 <= (Ν - ΜΗΚΟΣ[1]) ΕΠΑΝΑΛΑΒΕ
      Κ <- 0
      Π <- Π1 + 1
      ΓΙΑ Ι ΑΠΟ 1 ΜΕΧΡΙ Ν
        ΠΙΝ[Ι] <- 0
      ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
   
      ΑΡΧΗ_ΕΠΑΝΑΛΗΨΗΣ
        ΟΣΟ Κ < Μ ΕΠΑΝΑΛΑΒΕ
          Κ <- Κ + 1
          Λ <- 0
          ΟΣΟ Λ < ΜΠΛΟΚ[Κ] ΚΑΙ Π <= Ν ΕΠΑΝΑΛΑΒΕ
            Λ <- Λ + 1
            ΠΙΝ[Π] <- 1
            Π <- Π + 1
          ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
          ΑΝ Π < Ν ΤΟΤΕ
            ΠΙΝ[Π] <- 0
            Π <- Π + 1
            ΑΝ Κ < Μ ΤΟΤΕ
              ΑΝ (Π + ΜΗΚΟΣ[Κ + 1]) <= Ν ΤΟΤΕ
                ΣΤΟΙΒΑ <- ΣΤΟΙΒΑ + 1
                ΣΠ[ΣΤΟΙΒΑ] <- Π
                ΣΚ[ΣΤΟΙΒΑ] <- Κ
              ΤΕΛΟΣ_ΑΝ
            ΤΕΛΟΣ_ΑΝ
          ΤΕΛΟΣ_ΑΝ
        ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
     
        ΣΗΜΑΙΑ <- ΑΛΗΘΗΣ
        ΑΝ Λ = ΜΠΛΟΚ[Κ] ΤΟΤΕ
          ΓΙΑ Ι ΑΠΟ 1 ΜΕΧΡΙ Ν
            ΓΡΑΨΕ ΠΙΝ[Ι], "  "
          ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
          ΓΡΑΨΕ
          ΑΝ ΣΤΟΙΒΑ > 0 ΤΟΤΕ
            Π <- ΣΠ[ΣΤΟΙΒΑ]
            Κ <- ΣΚ[ΣΤΟΙΒΑ]
            ΣΤΟΙΒΑ <- ΣΤΟΙΒΑ - 1
            ΓΙΑ Ι ΑΠΟ Π ΜΕΧΡΙ Ν
              ΠΙΝ[Ι] <- 0
            ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
            Π <- Π + 1
            ΑΝ Κ < Μ ΤΟΤΕ
              ΑΝ (Π + ΜΗΚΟΣ[Κ + 1]) <= Ν ΤΟΤΕ
                ΣΤΟΙΒΑ <- ΣΤΟΙΒΑ + 1
                ΣΠ[ΣΤΟΙΒΑ] <- Π
                   ! το ΣΚ[ΣΤΟΙΒΑ]<-Κ δεν το βάζουμε είναι ήδη Κ
              ΤΕΛΟΣ_ΑΝ
            ΤΕΛΟΣ_ΑΝ
            ΣΗΜΑΙΑ <- ΨΕΥΔΗΣ
          ΤΕΛΟΣ_ΑΝ
        ΤΕΛΟΣ_ΑΝ
      ΜΕΧΡΙΣ_ΟΤΟΥ ΣΗΜΑΙΑ = ΑΛΗΘΗΣ
      Π1 <- Π1 + 1
    ΤΕΛΟΣ_ΕΠΑΝΑΛΗΨΗΣ
  ΤΕΛΟΣ_ΑΝ
ΤΕΛΟΣ_ΠΡΟΓΡΑΜΜΑΤΟΣ




Παρασκευή 8 Μαρτίου 2019

Revision 6 Version 9.8

1. Some fixes on Groups (user object)
In this example, we have a class alfa (is a global function), which have  private z, (also a private [k] as the value behind property k, and a public part with a module kappa and the property k (all properties are public). This property has no set part, so it is read only.
We make a group delta with two private groups, beta and delta of type alfa. (we can use beta=alfa(), and is the only way if we want to push some values for constructor, but here we have no user constructor for alfa class). Delta has a property, kk, which is a group like all properties, and as a group in a group, can't access parent group, except for the hidden variable [kk] and those variables which explicit  use of link parent to get a link to a reference.  Also in a value part of property we have access to final value if we change the value variable. This variable get the value of [kk] and this is the final return (so we can modify it without modified the actual private variable [kk])

So when we print delta.kk, we call value in property kk, where we get references to beta and delta private groups as b and d (we can use same name as beta and delta, they are in different name space), we call module b.kappa  and then we get the b.k and d.k which are properties, so they call value parts and ling to inner private z variable.

class alfa {
private:
 z=2
public:
 module kappa {
  Print "ok"
 }
 property k {
  value {
   link parent z to z
   value*=z
  }
 }=100
}
group delta {
private:
 alfa beta, delta
public:
 property kk {
  value {
   link parent beta to b
   link parent delta to d
   b.kappa
   value=b.k*d.k
  }
 }  
}
Print delta.kk

2. Unsigned literals (0xFFAACC11) now are Currency type. Binary operations also return Currency type. A 0xFFFFFFFF& is a long type (32bit), and 0xFFFF% is an integer type (16bit) (these not changed).

Τετάρτη 6 Μαρτίου 2019

Revision 5 Version 9.8

A small fix.
F2 and F3 function keys for EditBox control now have to normal operation (search up and down using marked text), as from older revisions/versions. In previous revision we could use search only by popup menu, or from keyboard using Shift, which open a dialog to show/alter the text to search. This bug come's by a mistake in an If statement which exclude the use of F2/F3 without SHIFT.

Code Editor in M2000 Environment use a different control, so was not affected.



Revision 4 Version 9.8 plus RIPEMD-160 example

New revision. Added Binary.Add() to add two or more numbers with modulo 2^32. This function needed for cryptographic functions.
This is one for RIPEMD-160, written for rosettacode.org task about it.

This implantation is for education only. We get the RIPEMD function from another function, the Prepare_RiPeMD_160() which make some arrays, and pass them as closures to the returned function. So in module TestHash we pass the lambda function and do all the tests. The last test, with 1 million "a", need more than an hour to complete. M2000 is an interpreter, with no AST yet. In my plans is a new version of M20000  to be prepared with an AST interpreter, to gain speed. The current interpreter consume source code as it runs. The AST interpreter, pass the source to a lexical analyzer, and then to a syntax analyzer. Compiling is not in my scope, but who knows, what a mind can think, sometimes.


Module Checkit {
 Function Prepare_RiPeMd_160 {
  Dim Base 0,  K(5), K1(5)
  K(0)=0x00000000, 0x5A827999, 0x6ED9EBA1, 0x8F1BBCDC, 0xA953FD4E
  K1(0)=0x50A28BE6,0x5C4DD124, 0x6D703EF3, 0x7A6D76E9, 0x00000000
  Dim Base 0,r(80), r1(80), s(80), s1(80)
  r(0)=0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
  r(16)=7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8
  r(32)= 3, 10, 14, 4, 9, 15, 8, 1, 2, 7, 0, 6, 13, 11, 5, 12
  r(48)=1, 9, 11, 10, 0, 8, 12, 4, 13, 3, 7, 15, 14, 5, 6, 2
  r(64)=4, 0, 5, 9, 7, 12, 2, 10, 14, 1, 3, 8, 11, 6, 15, 13
  k=r() : k*=4   ' k is a pointer to array. We have to multiply to make them offsets
  
  r1(0)=5, 14, 7, 0, 9, 2, 11, 4, 13, 6, 15, 8, 1, 10, 3, 12
  r1(16)=6, 11, 3, 7, 0, 13, 5, 10, 14, 15, 8, 12, 4, 9, 1, 2
  r1(32)=15, 5, 1, 3, 7, 14, 6, 9, 11, 8, 12, 2, 10, 0, 4, 13
  r1(48)=8, 6, 4, 1, 3, 11, 15, 0, 5, 12, 2, 13, 9, 7, 10, 14
  r1(64)=12, 15, 10, 4, 1, 5, 8, 7, 6, 2, 13, 14, 0, 3, 9, 11
  
  k=r1() : k*=4
  
  s(0)=11, 14, 15, 12, 5, 8, 7, 9, 11, 13, 14, 15, 6, 7, 9, 8
  s(16)=7, 6, 8, 13, 11, 9, 7, 15, 7, 12, 15, 9, 11, 7, 13, 12
  s(32)=11, 13, 6, 7, 14, 9, 13, 15, 14, 8, 13, 6, 5, 12, 7, 5
  s(48)=11, 12, 14, 15, 14, 15, 9, 8, 9, 14, 5, 6, 8, 6, 5, 12
  s(64)=9, 15, 5, 11, 6, 8, 13, 12, 5, 12, 13, 14, 11, 8, 5, 6
  
  s1(0)=8, 9, 9, 11, 13, 15, 15, 5, 7, 7, 8, 11, 14, 14, 12, 6
  s1(16)=9, 13, 15, 7, 12, 8, 9, 11, 7, 7, 12, 7, 6, 15, 13, 11
  s1(32)=9, 7, 15, 11, 8, 6, 6, 14, 12, 13, 5, 14, 13, 13, 7, 5
  s1(48)=15, 5, 8, 11, 14, 14, 6, 14, 6, 9, 12, 9, 12, 5, 15, 8
  s1(64)=8, 5, 12, 9, 12, 5, 14, 6, 8, 13, 6, 5, 15, 13, 11, 11
  
  Dim Base 0, T(5), TT(5)
  T(0)=lambda ->binary.xor(binary.xor(number,number),number)
  T(1)=lambda (B,C,D)->binary.or(binary.and(B,C), binary.and(binary.not(B), D))
  T(2)=lambda ->binary.xor(binary.or(number, binary.not(number)), number)
  T(3)=lambda (B,C,D)->binary.or(binary.and(B,D), binary.and(C,binary.not(D)))
  T(4)=lambda ->binary.xor(number, binary.or(number, binary.not(number)))
  
  \\ no need for variables we read form stack with number
  TT(0)=lambda ->binary.xor(number, binary.or(number, binary.not(number)))
  TT(1)=lambda (BB,CC,DD)->binary.or(binary.and(BB,DD), binary.and(CC,binary.not(DD))) 
  TT(2)=lambda ->binary.xor(binary.or(number, binary.not(number)), number)
  TT(3)=lambda (BB,CC,DD)->binary.or(binary.and(BB,CC), binary.and(binary.not(BB),DD)) 
  TT(4)=lambda ->binary.xor(binary.xor(number,number),number)
  
  \\ return of this function is a lambda function
  \\ all arrays are closures to this lambda
  =lambda K(),K1(),TT(), T(),r(),r1(), s(), s1() (&message$, ansi as boolean=true, ansiid=1033)-> {
   set fast!
   def h0 = 0x67452301, h1 = 0xEFCDAB89, h2 = 0x98BADCFE
   def h3 = 0x10325476, h4 = 0xC3D2E1F0
   def i, j, l, padding, l1, blocks, acc, f64 as boolean=true, oldid
   if ansi then oldid=locale : locale ansiid
   \\ we use a buffer of 64 bytes
   buffer clear message as byte*64
   l=len(message$)*if(ansi->1,2 )
   if binary.and(l,63)>55 then  padding=64 
   padding+= 64 - (l Mod 64)
   l1=padding+l+1
 
   f64=binary.and(l,63)<>0
 
   blocks=l1 div 64
rem
   Print "blocks:";blocks
   \\ now prepare the buffer
   PrepareBuffer()
   def decimal  A, B, C, D, E, AA, BB, CC, DD, EE, T, TT
   do
   A  = h0 : B  = h1 : C  = h2 : D  = h3 : E  = h4
   AA = h0 : BB = h1 : CC = h2 : DD = h3 : EE = h4
   for J=0 to 79 {
    JJ=J DIV 16
    PUSH binary.add(Binary.Rotate(binary.add(A,T(JJ)(B,C,D),eval(message ,r(j) as long),k(jj)), s(j)), e)
    A = E : E = D : D = Binary.Rotate(C, 10) : C = B : READ B 
    PUSH binary.add(Binary.Rotate(binary.add(AA,TT(JJ)(BB,CC,DD),eval(message, r1(j) as long),k1(jj)),s1(j)),EE)
    AA = EE : EE = DD : DD = Binary.Rotate(CC, 10) : CC = BB : READ BB
   }
   push binary.add(h1, C, DD)
   h1 = binary.add(h2, D, EE)
   h2 = binary.add(h3, E, AA)
   h3 = binary.add(h4, A, BB)
   h4 = binary.add(h0, B, CC)
   Read h0
   blocks--
rem
   print over $(0,8), blocks : Refresh
   if blocks=0 then exit
   PrepareBuffer()
   always
rem
   print
   buffer ans as byte*20
   \\ we put ulong (long is ulong in buffers)
   Return ans, 0:=h0 as long, 4:=h1 as long,8:=h2 as long, 12:=h3 as long, 16:=h4 as long
   =ans
   if ansi then locale oldid
   set fast
   Sub PrepareBuffer()
    
    if l-acc>=64 then
     LoadPart(64)
    else.if blocks=1 then
     return message, 0:=string$(chr$(0),32)
     if l-acc=0 and f64 then
      Return message, 56:=l*8 as long, 60 :=binary.shift(l,-29) as long
     else
      Return message, l-acc:=0x80, 56:=l*8 as long, 60 :=binary.shift(l,-29) as long
      if l>acc then LoadPart(l-acc)
     end if
    else
     Return message, l-acc:=0x80
     LoadPart(l-acc)
    end if
   End Sub
   sub LoadPart(many)
    \\ str$() convert to ansi, one byte per character
    \\ using 1033 as Ansi language
    if ansi then
     Return message, 0:=str$(mid$(message$,1+acc, many))
    else
     Return message, 0:=mid$(message$, 1+acc, many)
    end if
    acc+=many
   end sub
  }
 }
 Module TestHash (RIPEMD){
  Flush
  \\ push data to stack of values, as fifo (each entry append to end of stack)
  Data "b3be159860842cebaa7174c8fff0aa9e50a5199f","Rosetta Code"
  Data "9c1185a5c5e9fc54612808977ee8f548b2258d31",""
  Data "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe","a"
  Data "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc","abc"
  Data "5d0689ef49d2fae572b881b123a85ffa21595f36", "message digest"
  Data "f71c27109c692c1b56bbdceb5b9d2865b3708dbc","abcdefghijklmnopqrstuvwxyz"
  Data "b0e20b6e3116640286ed3a87a5713079b21f5189"
  Data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
  Data "9b752e45573d4b39f4dbd3323cab82bf63326bfb", String$("1234567890",8)
rem  Data "52783243c1697bdbe16d37f97f68f08325dc1528", String$("a",1000000)
  
  While not empty
   Read check$, text$
   Print "RIPEMD160 for ";quote$(Left$(if$(len(text$)>30->left$(text$,27)+"...",  text$),30))
   \\ pass text$ by reference
   Display(RIPEMD(&text$))
  End While
  
  sub Display(ans)
   local answer$
   for i=0 to len(ans)-1
    answer$+=hex$(eval(ans,i),1)
   next i
   Print lcase$(answer$)
   Print lcase$(answer$)=check$
  end sub
 }
 TestHash Prepare_RiPeMd_160() 
}
Checkit