Παρασκευή 28 Αυγούστου 2026

Version 15 Revision 34

Βρήκα ένα λάθος καθώς έφτιαχνα αυτό το πρόγραμμα. Η εντολή ΤΕΛΟΣ έκανε απότομη έξοδο από τη συνάρτηση με συνέπεια η δεύτερη κλήση της να αποτύχει! Φτιάχτηκε, και τώρα η ΤΕΛΟΣ μόνο από τη γραμμή εντολών δίνει τερματισμό.

Το πρόγραμμα τρέχει το παρακάτω πρόγραμμα που οδηγεί μια "χελώνα" γραφικών (ένα βέλος εδώ).

Το διαφορετικό σε αυτό το πρόγραμμα είναι η χρήση συμβόλων. Τα σύμβολα είναι μια ιδέα που έχω εφαρμόσει από την αναθεώρηση 25 έκδοση 15.  Μπορούμε να διαβάζουμε σύμβολα χωρίς να χαλάμε τη σειρά των κανονικών παραμέτρων! Τα χρώματα είναι σταθερές, όμως η ΠΕΝΑ είναι ρουτίνα που δηλώσαμε οτι είναι στατική ρουτίνα και παίζει στη θέση της κανονικής ΠΕΝΑ (την κανονική την καλούμε με το @ΠΕΝΑ). Όμως δείτε ότι εκτός από τα χρώματα που βάζουμε και μπορούμε να βάλουμε το ΧΡΩΜΑ(100,200,30) ή το #12AACC (html κωδικοποίηση χρώματος), ή το ΧΚΦ(60,100,50)  με χροιά 60 μοίρες, κορεσμός 100%, φωτεινότητα 50%, εδώ μπορούμε να βάλουμε τα σύμβολα ΠΑΝΩ και ΚΑΤΩ με τα οποία σηκώνουμε ή κατεβάζουμε τη πένα.

Ομοίως και η ΧΑΡΑΞΕ είναι εντολή της Μ2000 αλλά εδώ έχουμε βάλει μια ρουτίνα να παίξει το ρόλο της ΧΑΡΑΞΕ με δυο σύμβολα το ΚΥΚΛΟ και ΤΟΜΕΑ. Έτσι έχουμε φτιάξει δυο εντολές ΧΑΡΑΞΕ ΚΥΚΛΟ και ΧΑΡΑΞΕ ΤΟΜΕΑ (με δυο λέξεις). Και οι ΘΕΣΗ, ΔΕΙΞΕ, ΣΤΡΙΨΕ και ΤΡΑΒΑ έχουν σύμβολα.

Ενα άλλο στοιχείο που έχει μόνο αυτή η έκδοση, είναι ότι στην κλήση της συνάρτησης μπορούμε να περάσουμε σταθερές (με το := δίνουμε τη τιμή), Δείτε αυτό:

ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΑΛΗΘΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΧ:=-ΚΛΙΜΑΞ.Χ/2.8, ΒΟΡΡΑΣ:=190, ΜΕΓΕΘΟΣ:=0.9, ΓΡΑΦΙΚΟ:=ΚΩΔΙΚΑΣ)

Τα ορίσματα που δίνουμε δεν είναι παράμετροι που διαβάζει στη σειρά η συνάρτηση. Εμείς δίνουμε τα ορίσματα και στη συνάρτηση κοιτάμε αν υπάρχουν και αν όχι τα δημιουργούμε με αρχικές τιμές! Θα μπορούσαμε να δώσουμε τιμές κανονικές και όχι σε σταθερές (που δεν αλλάζουν). Στο παρακάτω παράδειγμα οι μεταβλητές είναι κανονικές μπορούν να αλλάξουν τιμή. Δείτε πως τις ορίζουμε με το % στην αρχή και απλό =.

ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(%ΒΗΜΑΤΙΚΟ=ΑΛΗΘΕΣ, %ΔΤ=15, %ΚΑΘΑΡΙΣΕ=ΨΕΥΔΕΣ, %ΘΕΣΗΧ=-ΚΛΙΜΑΞ.Χ/2.8, %ΒΟΡΡΑΣ=190, %ΜΕΓΕΘΟΣ=0.9, %ΓΡΑΦΙΚΟ=ΚΩΔΙΚΑΣ)


ΣΤΑΤΙΚΗ ΡΟΥΤΙΝΑ ΣΠΙΤΙ, ΠΑΡΑΛΛΗΛΟΓΡΑΜΜΟ 
ΘΕΣΗ ΚΕΝΤΡΟ
ΠΑΧΟΣ ΓΡΑΜΜΗΣ 4
ΠΕΝΑ ΚΟΚΚΙΝΗ
ΣΤΑΘΕΡΗ ΖΖ=13
ΣΤΡΙΨΕ ΔΕΞΙΑ ΖΖ
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "Α", 225,,,-ΖΖ
ΤΡΑΒΑ ΜΠΡΟΣΤΑ 4000
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "90°     ", -20, ΜΠΛΕ,200, -ΖΖ
ΠΕΝΑ ΜΑΥΡΗ
ΧΑΡΑΞΕ ΤΟΜΕΑ 300, -5, 275, -ΖΖ
ΠΕΝΑ ΚΟΚΚΙΝΗ
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "Β", 135,,,-ΖΖ
ΤΡΑΒΑ ΑΡΙΣΤΕΡΑ 3000
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "Γ",45,,,-ΖΖ
ΣΤΡΙΨΕ ΔΕΞΙΑ 270-ΤΟΞ.ΕΦ(3000/4000)
ΤΡΑΒΑ ΜΠΡΟΣΤΑ 5000
ΣΤΡΙΨΕ ΠΡΟΣ 180  ' ΣΕ ΣΧΕΣΗ ΜΕ ΤΟΝ ΒΟΡΡΑ (ΟΠΩΣ ΕΧΕΙ ΕΠΙΛΕΧΘΕΙ)
ΠΕΝΑ ΠΑΝΩ
ΤΡΑΒΑ ΜΠΡΟΣΤΑ 6000
ΠΕΝΑ ΚΑΤΩ
ΠΕΝΑ ΠΡΑΣΙΝΗ
ΣΠΙΤΙ 5000
ΡΟΥΤΙΝΑ ΣΠΙΤΙ(ν)
ΤΟΠΙΚΗ ι
ΓΙΑ ι=1 ΕΩΣ 2
ΣΤΡΙΨΕ ΔΕΞΙΑ 120
ΤΡΑΒΑ ΜΠΡΟΣΤΑ ν
ΕΠΟΜΕΝΟ
ΣΤΡΙΨΕ ΔΕΞΙΑ 120
ΣΤΡΙΨΕ ΠΙΣΩ
ΠΑΡΑΛΛΗΛΟΓΡΑΜΜΟ ν, ν
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΠΑΡΑΛΛΗΛΟΓΡΑΜΜΟ(π, υ)
ΤΟΠΙΚΗ ι
ΓΙΑ ι=1 ΕΩΣ 2
ΤΡΑΒΑ ΔΕΞΙΑ π
ΤΡΑΒΑ ΔΕΞΙΑ υ
ΕΠΟΜΕΝΟ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ 









ΑΝ ΕΚΔΟΣΗ<15 ΤΟΤΕ ΕΞΟΔΟΣ
ΑΝ ΕΚΔΟΣΗ=15 ΚΑΙ ΑΝΑΘΕΩΡΗΣΗ<34 ΤΟΤΕ ΕΞΟΔΟΣ
'Τα σύμβολα επεκτείνουν τις ρουτίνες.
ΣΥΜΒΟΛΟ ΠΑΝΩ, ΚΑΤΩ, ΚΥΚΛΟ, ΤΟΜΕΑ
ΣΥΜΒΟΛΟ ΚΕΝΤΡΟ, ΟΘΟΝΗΣ, ΠΙΣΩ, ΜΠΡΟΣΤΑ
ΣΥΜΒΟΛΟ ΔΕΞΙΑ, ΑΡΙΣΤΕΡΑ, ΠΡΟΣ, ΓΡΑΜΜΗΣ, ΓΡΑΜΜΑΤΑ


' Προετοιμάζουμε το μέγθος της οθόνης μας
ΓΡΑΜΜΑΤΟΣΕΙΡΑ_ΠΑΛΙΑ=ΓΡΑΜΜΑΤΟΣΕΙΡΑ$
ΦΑΡΔΙΑ_ΠΑΛΙΑ=ΦΑΡΔΙΑ
ΠΛΑΓΙΑ_ΠΑΛΙΑ=ΠΛΑΓΙΑ
Μ_ΠΑΛΙΟ=ΤΥΠΟΣ ' ΜΕΓΕΘΟΣ ΧΑΡΑΚΤΗΡΩΝ
ΦΑΡΔΙΑ 1
ΠΛΑΓΙΑ 0
ΓΡΑΜΜΑΤΟΣΕΙΡΑ "ARIAL"
ΣΥΝΑΡΤΗΣΗ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ {
ΣΤΑΤΙΚΗ ΡΟΥΤΙΝΑ ΘΕΣΗ, ΒΕΛΟΣ, ΔΕΙΞΕ, ΠΕΝΑ, ΠΑΧΟΣ, ΧΑΡΑΞΕ, ΤΡΑΒΑ, ΣΤΡΙΨΕ
ΑΠΑΡΙΘΜΗΣΗ ΧΡΩΜΑΤΑ {
ΜΑΥΡΗ=#000000, ΠΡΑΣΙΝΗ=#005500, ΜΠΛΕ=#0000FF, ΚΟΚΚΙΝΗ=#FF0000
}
ΑΔΕΙΑΣΕ
ΑΝ ΟΧΙ ΕΓΚΥΡΟ(ΒΗΜΑΤΙΚΟ) ΤΟΤΕ ΒΗΜΑΤΙΚΟ=ΨΕΥΔΗΣ
ΑΝ ΟΧΙ ΕΓΚΥΡΟ(ΚΑΘΑΡΙΣΕ) ΤΟΤΕ ΚΑΘΑΡΙΣΕ=ΑΛΗΘΗΣ
ΑΝ ΟΧΙ ΕΓΚΥΡΟ(ΔΤ) ΤΟΤΕ ΔΤ=100
ΑΝ ΟΧΙ ΕΓΚΥΡΟ(ΒΟΡΡΑΣ) ΤΟΤΕ ΒΟΡΡΑΣ=90
ΑΝ ΕΓΚΥΡΟ(ΜΕΓΕΘΟΣ) ΤΟΤΕ ΖΟΥΜ=ΜΕΓΕΘΟΣ ΑΛΛΙΩΣ ΖΟΥΜ=1
ΑΝ ΟΧΙ ΕΓΚΥΡΟ(ΘΕΣΗΧ) ΤΟΤΕ ΘΕΣΗΧ=0
ΑΝ ΟΧΙ ΕΓΚΥΡΟ(ΘΕΣΗΥ) ΤΟΤΕ ΘΕΣΗΥ=0
ΑΝ ΕΓΚΥΡΟ(ΚΥΡΙΟ_ΖΟΥΜ) ΤΟΤΕ
ΖΟΥΜ*=ΚΥΡΙΟ_ΖΟΥΜ
ΑΛΛΙΩΣ
ΤΟΠΙΚΗ ΚΥΡΙΟ_ΖΟΥΜ ΩΣ ΑΠΛΟΣ=1
ΤΕΛΟΣ ΑΝ
ΣΤΑΘΕΡΗ ΠΙ ΩΣ ΑΠΛΟΣ=3.1415926
ΛΟΓΙΚΟΣ η_πένα_γράφει=ΑΛΗΘΕΣ
ΑΠΛΟΣ γωνία_πένας=(ΒΟΡΡΑΣ-90)*ΠΙ/180
ΑΚΕΡΑΙΟΣ πάχος_γραμμής=1


ΣΥΝΑΡΤΗΣΗ ΕΙΚ(ΧΡ){
ΣΧΕΔΙΟ 3000, 3000 {
ΘΕΣΗ 0,0
ΠΑΧΟΣ 4{
ΧΑΡΑΞΕ ΕΩΣ 3000, 1500, ΧΡ
ΧΑΡΑΞΕ ΕΩΣ 0, 3000, ΧΡ
ΧΑΡΑΞΕ ΕΩΣ 1000, 1500, ΧΡ
ΧΑΡΑΞΕ ΕΩΣ 0,0, ΧΡ
}
} ΩΣ ΒΕΛΟΣ
=ΒΕΛΟΣ
}
ΟΜΑΛΑ ΝΑΙ
ΒΕΛΟΣ=ΕΙΚ(0)
ΑΝ ΚΑΘΑΡΙΣΕ ΤΟΤΕ ΟΘΟΝΗ,0
ΚΡΑΤΗΣΕ
ΑΝ ΕΓΚΥΡΟ(ΓΡΑΦΙΚΟ) ΤΟΤΕ
ΕΝΘΕΣΗ "ΤΜΗΜΑ ΚΩΔ {"+{
}+ΓΡΑΦΙΚΟ+{
}+"}"
ΚΑΛΕΣΕ ΤΟΠΙΚΑ ΚΩΔ
ΤΕΛΟΣ ΑΝ
ΑΦΗΣΕ
@ΠΕΝΑ 0
ΤΕΛΟΣ
// Ακολουθούν οι έτοιμες ρουτίνες
ΡΟΥΤΙΝΑ ΔΕΙΞΕ(Α!,Γ$, ΠΟΥ, ΧΡ=0, ΜΕΓ=100, ΠΕΡ=0)
ΑΝ Α=ΓΡΑΜΜΑΤΑ ΑΛΛΙΩΣ ΛΑΘΟΣ "ΥΠΟΣΤΗΡΙΖΩ ΜΟΝΟ ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ"
ΑΦΗΣΕ
ΠΟΥ-=ΒΟΡΡΑΣ+ΠΕΡ
ΒΗΜΑ ΓΩΝΙΑ -ΠΟΥ/180*ΠΙ, 300*ΜΕΓ/100*ΖΟΥΜ
@ΠΕΝΑ ΧΡ {
ΕΠΙΓΡΑΦΗ Γ$,ΓΡΑΜΜΑΤΟΣΕΙΡΑ$,ΤΥΠΟΣ*ΜΕΓ/100*ΖΟΥΜ, (ΒΟΡΡΑΣ-90+ΠΕΡ)*ΠΙ/180, 2
}
ΒΗΜΑ ΓΩΝΙΑ -ΠΟΥ/180*ΠΙ, -300*ΜΕΓ/100*ΖΟΥΜ
ΒΕΛΟΣ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΠΕΝΑ(ΣΥΜ!)
ΕΠΙΛΕΞΕ ΜΕ ΣΥΜ
ΜΕ ΠΑΝΩ
η_πένα_γράφει=ΨΕΥΔΕΣ
ΕΞΟΔΟΣ ΡΟΥΤΙΝΑΣ
ΜΕ ΚΑΤΩ
η_πένα_γράφει=ΑΛΗΘΕΣ
ΕΞΟΔΟΣ ΡΟΥΤΙΝΑΣ
ΜΕ ""
ΔΙΑΒΑΣΕ ΤΟΠΙΚΑ ΧΡ=0
@ΠΕΝΑ ΧΡ
ΤΕΛΟΣ ΕΠΙΛΟΓΗΣ
ΒΕΛΟΣ=ΕΙΚ(ΠΕΝΑ)
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΘΕΣΗ(Α!)
ΑΝ Α=ΚΕΝΤΡΟ ΤΟΤΕ
ΑΦΗΣΕ
@ΘΕΣΗ (ΚΛΙΜΑΞ.Χ ΔΙΑ 2)+ΘΕΣΗΧ, (ΚΛΙΜΑΞ.Υ ΔΙΑ 2)+ΘΕΣΗΥ
ΒΕΛΟΣ
ΑΛΛΙΩΣ.ΑΝ Α=ΟΘΟΝΗΣ ΤΟΤΕ
ΔΙΑΒΑΣΕ ΤΟΠΙΚΑ Χ, Υ
ΑΦΗΣΕ
Χ*=ΚΥΡΙΟ_ΖΟΥΜ:Υ*=ΚΥΡΙΟ_ΖΟΥΜ
@ΘΕΣΗ Χ+ΘΕΣΗΧ, Υ+ΘΕΣΗΥ
ΒΕΛΟΣ
ΑΛΛΙΩΣ
ΛΑΘΟΣ "ΑΓΝΩΣΤΟ "+Α
ΤΕΛΟΣ ΑΝ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΠΑΧΟΣ(Α!)
ΑΝ Α=ΓΡΑΜΜΗΣ ΑΛΛΙΩΣ ΛΑΘΟΣ "ΥΠΟΣΤΗΡΙΖΩ ΜΟΝΟ ΠΑΧΟΣ ΓΡΑΜΜΗΣ"
ΔΙΑΒΑΣΕ ΤΟΠΙΚΑ τόσο ΩΣ ΑΚΕΡΑΙΟΣ
ΤΟΠΙΚΗ τ ΩΣ ΑΠΛΟΣ
τ=τόσο*ΚΥΡΙΟ_ΖΟΥΜ
τόσο=τ 'μεταροπή σε ακέραιο
ΑΝ τόσο<1 ΤΟΤΕ τόσο=1
ΑΝ τόσο>15 ΤΌΤΕ τόσο=15
πάχος_γραμμής=τόσο
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΧΑΡΑΞΕ(Α!)
ΑΝ Α=ΚΥΚΛΟ ΤΟΤΕ
ΔΙΑΒΑΣΕ ΤΟΠΙΚΗ ακτίνα
ΑΦΗΣΕ
ΑΝ η_πένα_γράφει ΤΟΤΕ
@ΠΑΧΟΣ πάχος_γραμμής {
ΚΥΚΛΟΣ ακτίνα*ΚΥΡΙΟ_ΖΟΥΜ
}
ΤΕΛΟΣ ΑΝ
ΒΕΛΟΣ
ΑΛΛΙΩΣ.ΑΝ Α=ΤΟΜΕΑ ΤΟΤΕ
ΔΙΑΒΑΣΕ ΤΟΠΙΚΑ ακτίνα, αρχ=0, τελ=360, ΠΕΡ=0
ΑΦΗΣΕ
ΑΝ η_πένα_γράφει ΤΟΤΕ
@ΠΑΧΟΣ πάχος_γραμμής {
ΚΥΚΛΟΣ ακτίνα*ΚΥΡΙΟ_ΖΟΥΜ,1,ΠΕΝΑ,(ΒΟΡΡΑΣ-αρχ+ΠΕΡ)/180*ΠΙ, (ΒΟΡΡΑΣ-τελ+ΠΕΡ)/180*ΠΙ;
}
ΤΕΛΟΣ ΑΝ
ΒΕΛΟΣ
ΤΕΛΟΣ ΑΝ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΤΡΑΒΑ(Α!)
ΑΝ Α="" ΤΟΤΕ ΛΑΘΟΣ "ΔΕΝ ΟΡΙΣΕΣ ΚΑΤΕΥΘΥΝΣΗ"
ΔΙΑΒΑΣΕ ΤΟΠΙΚΟ απόσταση
ΑΝ Α=ΜΠΡΟΣΤΑ ΤΟΤΕ
ΑΛΛΙΩΣ.ΑΝ Α=ΠΙΣΩ ΤΟΤΕ
απόσταση-!
ΑΛΛΙΩΣ.ΑΝ Α=ΔΕΞΙΑ ΤΟΤΕ
γωνία_πένας-=ΠΙ/2
ΑΛΛΙΩΣ.ΑΝ Α=ΑΡΙΣΤΕΡΑ ΤΟΤΕ
γωνία_πένας+=ΠΙ/2
ΑΛΛΙΩΣ
ΛΑΘΟΣ "ΑΓΝΩΣΤΟ "+Α
ΤΕΛΟΣ ΑΝ
απόσταση*=ΖΟΥΜ
ΑΦΗΣΕ
ΑΝ η_πένα_γράφει ΤΟΤΕ
@ΠΑΧΟΣ πάχος_γραμμής {
ΑΝ ΒΗΜΑΤΙΚΟ ΤΟΤΕ
ΤΟΠΙΚΗ ΜΒ=15
ΤΟΠΙΚΗ ΒΗΜ=ΑΠΟΛ(απόσταση) ΔΙΑ (ΜΒ*ΚΥΡΙΟ_ΖΟΥΜ)
ΑΝ ΒΗΜ>10 ΤΟΤΕ
ΜΒ=ΑΠΟΛ(απόσταση) ΔΙΑ (10*ΚΥΡΙΟ_ΖΟΥΜ)
ΒΗΜ=ΑΠΟΛ(απόσταση) ΔΙΑ (ΜΒ*ΚΥΡΙΟ_ΖΟΥΜ)
ΤΕΛΟΣ ΑΝ
ΑΝ ΒΗΜ>0 ΤΟΤΕ
ΤΟΠΙΚΗ ΒΗΜ1=ΜΒ*ΣΗΜ(απόσταση)*ΚΥΡΙΟ_ΖΟΥΜ
ΒΗΜΑ ΓΩΝΙΑ γωνία_πένας, απόσταση
ΤΟΠΙΚΕΣ Ι ΩΣ ΑΚΕΡΑΙΟΣ, ΧΘ=ΘΕΣΗ.Χ, ΥΘ=ΘΕΣΗ.Υ
ΒΗΜΑ ΓΩΝΙΑ γωνία_πένας, -απόσταση
ΓΙΑ Ι=1 ΕΩΣ ΒΗΜ
@ΧΑΡΑΞΕ ΓΩΝΙΑ γωνία_πένας, ΒΗΜ1
ΒΕΛΟΣ
ΑΦΗΣΕ
ΕΠΟΜΕΝΟ Ι
@ΧΑΡΑΞΕ ΕΩΣ ΧΘ, ΥΘ
ΑΛΛΙΩΣ
@ΧΑΡΑΞΕ ΓΩΝΙΑ γωνία_πένας, απόσταση
ΤΕΛΟΣ ΑΝ
ΑΛΛΙΩΣ
@ΧΑΡΑΞΕ ΓΩΝΙΑ γωνία_πένας, απόσταση
ΤΕΛΟΣ ΑΝ
}
ΑΛΛΙΩΣ
ΑΝ ΒΗΜΑΤΙΚΟ ΤΟΤΕ
ΤΟΠΙΚΗ ΒΗΜ=ΑΠΟΛ(απόσταση) ΔΙΑ (300*ΚΥΡΙΟ_ΖΟΥΜ)
ΑΝ ΒΗΜ>0 ΤΟΤΕ
ΤΟΠΙΚΗ ΒΗΜ1=300*ΣΗΜ(απόσταση)*ΚΥΡΙΟ_ΖΟΥΜ
ΒΗΜΑ ΓΩΝΙΑ γωνία_πένας, απόσταση
ΤΟΠΙΚΕΣ Ι ΩΣ ΑΚΕΡΑΙΟΣ, ΧΘ=ΘΕΣΗ.Χ, ΥΘ=ΘΕΣΗ.Υ
ΒΗΜΑ ΓΩΝΙΑ γωνία_πένας, -απόσταση
ΓΙΑ Ι=1 ΕΩΣ ΒΗΜ
ΒΗΜΑ ΓΩΝΙΑ γωνία_πένας, ΒΗΜ1
ΒΕΛΟΣ
ΑΦΗΣΕ
ΕΠΟΜΕΝΟ Ι
@ΘΕΣΗ ΧΘ, ΥΘ
ΑΛΛΙΩΣ
ΒΗΜΑ ΓΩΝΙΑ γωνία_πένας, απόσταση
ΤΕΛΟΣ ΑΝ
ΑΛΛΙΩΣ
ΒΗΜΑ ΓΩΝΙΑ γωνία_πένας, απόσταση
ΤΕΛΟΣ ΑΝ
ΤΕΛΟΣ ΑΝ
ΒΕΛΟΣ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΣΤΡΙΨΕ(Α!)
ΑΝ Α="" ΤΟΤΕ ΛΑΘΟΣ "ΔΕΝ ΟΡΙΣΕΣ ΠΟΥ ΘΕΣ ΝΑ ΣΤΡΙΨΩ"
ΔΙΑΒΑΣΕ ΤΟΠΙΚΟ γωνία_σε_μοίρες=0
ΑΦΗΣΕ
ΑΝ Α=ΔΕΞΙΑ ΤΟΤΕ
γωνία_πένας-=γωνία_σε_μοίρες/180*ΠΙ
ΑΛΛΙΩΣ.ΑΝ Α=ΑΡΙΣΤΕΡΑ ΤΟΤΕ
γωνία_πένας+=γωνία_σε_μοίρες/180*ΠΙ
ΑΛΛΙΩΣ.ΑΝ Α=ΠΡΟΣ ΤΟΤΕ
γωνία_πένας=(γωνία_σε_μοίρες+ΒΟΡΡΑΣ-90)/180*ΠΙ
ΑΛΛΙΩΣ.ΑΝ Α=ΠΙΣΩ ΤΟΤΕ
γωνία_πένας+=ΠΙ
ΑΛΛΙΩΣ
ΛΑΘΟΣ "ΔΕΝ ΓΝΩΡΙΧΩ ΤΟ "+Α
ΤΕΛΟΣ ΑΝ
ΒΕΛΟΣ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΒΕΛΟΣ()
ΚΡΑΤΗΣΕ
ΑΝ ΒΗΜΑΤΙΚΟ ΤΟΤΕ
ΕΙΚΟΝΑ ΒΕΛΟΣ, 600*ΚΥΡΙΟ_ΖΟΥΜ,,γωνία_πένας*180/ΠΙ
ΑΝΑΝΕΩΣΗ 1000
ΑΝΑΜΟΝΗ ΔΤ
ΤΕΛΟΣ ΑΝ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
}
' Εδώ σε ένα αλφαριθμητικό βάζουμε το πρόγραμμα και το δίνουμε στη ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ()
ΠΡΩΤΟΤΥΠΟ {
ΣΤΑΤΙΚΗ ΡΟΥΤΙΝΑ ΣΠΙΤΙ, ΠΑΡΑΛΛΗΛΟΓΡΑΜΜΟ
ΘΕΣΗ ΚΕΝΤΡΟ
ΠΑΧΟΣ ΓΡΑΜΜΗΣ 4
ΠΕΝΑ ΚΟΚΚΙΝΗ
ΣΤΑΘΕΡΗ ΖΖ=13
ΣΤΡΙΨΕ ΔΕΞΙΑ ΖΖ
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "Α", 225,,,-ΖΖ
ΤΡΑΒΑ ΜΠΡΟΣΤΑ 4000
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "90°     ", -20, ΜΠΛΕ,200, -ΖΖ
ΠΕΝΑ ΜΑΥΡΗ
ΧΑΡΑΞΕ ΤΟΜΕΑ 300, -5, 275, -ΖΖ
ΠΕΝΑ ΚΟΚΚΙΝΗ
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "Β", 135,,,-ΖΖ
ΤΡΑΒΑ ΑΡΙΣΤΕΡΑ 3000
ΔΕΙΞΕ ΓΡΑΜΜΑΤΑ "Γ",45,,,-ΖΖ
ΣΤΡΙΨΕ ΔΕΞΙΑ 270-ΤΟΞ.ΕΦ(3000/4000)
ΤΡΑΒΑ ΜΠΡΟΣΤΑ 5000
ΣΤΡΙΨΕ ΠΡΟΣ 180 ' ΣΕ ΣΧΕΣΗ ΜΕ ΤΟΝ ΒΟΡΡΑ (ΟΠΩΣ ΕΧΕΙ ΕΠΙΛΕΧΘΕΙ)
ΠΕΝΑ ΠΑΝΩ
ΤΡΑΒΑ ΜΠΡΟΣΤΑ 6000
ΠΕΝΑ ΚΑΤΩ
ΠΕΝΑ ΠΡΑΣΙΝΗ
ΣΠΙΤΙ 5000
ΡΟΥΤΙΝΑ ΣΠΙΤΙ(ν)
ΤΟΠΙΚΗ ι
ΓΙΑ ι=1 ΕΩΣ 2
ΣΤΡΙΨΕ ΔΕΞΙΑ 120
ΤΡΑΒΑ ΜΠΡΟΣΤΑ ν
ΕΠΟΜΕΝΟ
ΣΤΡΙΨΕ ΔΕΞΙΑ 120
ΣΤΡΙΨΕ ΠΙΣΩ
ΠΑΡΑΛΛΗΛΟΓΡΑΜΜΟ ν, ν
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
ΡΟΥΤΙΝΑ ΠΑΡΑΛΛΗΛΟΓΡΑΜΜΟ(π, υ)
ΤΟΠΙΚΗ ι
ΓΙΑ ι=1 ΕΩΣ 2
ΤΡΑΒΑ ΔΕΞΙΑ π
ΤΡΑΒΑ ΔΕΞΙΑ υ
ΕΠΟΜΕΝΟ
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ
}  ΩΣ ΚΩΔΙΚΑΣ
ΓΕΝΙΚΗ ΚΥΡΙΟ_ΖΟΥΜ=ΚΛΙΜΑΞ.Χ/ΠΛΑΤΟΣ.ΣΗΜΕΙΟΥ/1792


ΠΑΡΑΘΥΡΟ 19,ΣΥΣΚΕΥΗ
ΠΕΡΙΘΩΡΙΟ {ΟΘΟΝΗ 0,0 : ΜΕΓΙΣΤΟ=ΚΛΙΜΑΞ.Χ}
ΟΘΟΝΗ 15,0
ΠΕΝΑ 0


ΚΛΙΜΑΚΕΣ =(100/100, 85/100, 70/100, 60/100)
ΚΛ=ΚΑΘΕ(ΚΛΙΜΑΚΕΣ)
ΕΝΩ ΚΛ
ΚΛΙΜΑΚΑ=ΠΙΝΑΚΑΣ(ΚΛ)
ΠΛΑΤΟΣ.Χ.TWIPS=ΜΕΓΙΣΤΟ*ΚΛΙΜΑΚΑ
ΠΑΡΑΘΥΡΟ 6, ΣΥΣΚΕΥΗ
ΠΑΡΑΘΥΡΟ Μ_ΠΑΛΙΟ*ΚΛΙΜΑΚΑ, ΠΛΑΤΟΣ.Χ.TWIPS, ΠΛΑΤΟΣ.Χ.TWIPS*1080/1920;
ΦΟΡΜΑ;
ΚΥΡΙΟ_ΖΟΥΜ <= ΚΛΙΜΑΞ.Χ/ΠΛΑΤΟΣ.ΣΗΜΕΙΟΥ/1792
ΔΟΚΙΜΑΣΤΚΟ()
ΤΕΛΟΣ ΕΝΩ


'ΕΠΙΦΑΝΕΙΑ 255
ΠΛΑΓΙΑ ΠΛΑΓΙΑ_ΠΑΛΙΑ
ΦΑΡΔΙΑ ΦΑΡΔΙΑ_ΠΑΛΙΑ
ΓΡΑΜΜΑΤΟΣΕΙΡΑ ΓΡΑΜΜΑΤΟΣΕΙΡΑ_ΠΑΛΙΑ
ΠΑΡΑΘΥΡΟ Μ_ΠΑΛΙΟ, ΣΥΣΚΕΥΗ


ΡΟΥΤΙΝΑ ΔΟΚΙΜΑΣΤΚΟ()
ΑΝΑΛΥΤΗΣ
ΦΟΝΤΟ 15, #AAFFBB
' περασμα μεταβλητών ως σταθερές.
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΑΛΗΘΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΧ:=-ΚΛΙΜΑΞ.Χ/2.8, ΒΟΡΡΑΣ:=190, ΜΕΓΕΘΟΣ:=0.9, ΓΡΑΦΙΚΟ:=ΚΩΔΙΚΑΣ)
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΑΛΗΘΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΧ:=ΚΛΙΜΑΞ.Χ/2.8, ΒΟΡΡΑΣ:=10, ΜΕΓΕΘΟΣ:=0.9, ΓΡΑΦΙΚΟ:= ΚΩΔΙΚΑΣ)
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΑΛΗΘΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΥ:=-ΚΛΙΜΑΞ.Υ/3.8, ΒΟΡΡΑΣ:=100, ΜΕΓΕΘΟΣ:=0.7, ΓΡΑΦΙΚΟ:= ΚΩΔΙΚΑΣ)
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΑΛΗΘΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΥ:=ΚΛΙΜΑΞ.Υ/3.8, ΒΟΡΡΑΣ:=280, ΜΕΓΕΘΟΣ:=0.7, ΓΡΑΦΙΚΟ:=ΚΩΔΙΚΑΣ)
ΔΡΟΜΕΑΣ 0,0
ΤΥΠΩΣΕ "ΓΡΑΦΙΚΑ ΧΕΛΩΝΑΣ - ΒΗΜΑΤΙΚΗ ΕΚΤΕΛΕΣΗ "+((ΦΟΡΤΟΣ ΔΙΑ 100)/10)+" δευτ. - κλίμακα:"+(ΚΛΙΜΑΚΑ*100)+":100"
ΑΝΑΝΕΩΣΗ 25
Α$=ΚΟΜ$
ΑΝΑΝΕΩΣΗ 3000
ΑΝΑΛΥΤΗΣ
ΦΟΝΤΟ 15, #AACC99
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΨΕΥΔΕΣ, ΔΤ:=15,ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΧ:=-ΚΛΙΜΑΞ.Χ/2.8, ΒΟΡΡΑΣ:=190, ΜΕΓΕΘΟΣ:=0.9, ΓΡΑΦΙΚΟ:=ΚΩΔΙΚΑΣ)
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΨΕΥΔΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΧ:=ΚΛΙΜΑΞ.Χ/2.8, ΒΟΡΡΑΣ:=10, ΜΕΓΕΘΟΣ:=0.9, ΓΡΑΦΙΚΟ:= ΚΩΔΙΚΑΣ)
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΨΕΥΔΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΥ:=-ΚΛΙΜΑΞ.Υ/3.8, ΒΟΡΡΑΣ:=100, ΜΕΓΕΘΟΣ:=0.7, ΓΡΑΦΙΚΟ:= ΚΩΔΙΚΑΣ)
ΚΑΛΕΣΕ ΓΡΑΦΙΚΑ_ΧΕΛΩΝΑΣ(ΒΗΜΑΤΙΚΟ:=ΨΕΥΔΕΣ, ΔΤ:=15, ΚΑΘΑΡΙΣΕ:=ΨΕΥΔΕΣ, ΘΕΣΗΥ:=ΚΛΙΜΑΞ.Υ/3.8, ΒΟΡΡΑΣ:=280, ΜΕΓΕΘΟΣ:=0.7, ΓΡΑΦΙΚΟ:=ΚΩΔΙΚΑΣ)
ΔΡΟΜΕΑΣ 0,0
ΤΥΠΩΣΕ "ΓΡΑΦΙΚΑ ΧΕΛΩΝΑΣ - ΧΩΡΙΣ ΒΗΜΑΤΙΚΗ ΕΚΤΕΛΕΣΗ "+((ΦΟΡΤΟΣ ΔΙΑ 100)/10)+" δευτ. - κλίμακα:"+(ΚΛΙΜΑΚΑ*100)+":100"
ΑΝΑΝΕΩΣΗ 25
Α$=ΚΟΜ$
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ


Δευτέρα 24 Αυγούστου 2026

Version 15 Revision 29

This revsion fix an error situation which I discover using casting on objects. So this normaly never happen. But the interesting part is I find some unexpected behaviour of Visual Basic 6. M2000 Interpereter compiled as an activeX dll from VB6. The M2000.exe is a small program which load this dll. (you can use M2000 as an object from another language)

I named this situation as Bomb Situation, because previous revisions hang on Type(testme)  function. The reason? I don't now why but I now how this repeated. The testme object is the same as the object a, but they have different vtables, so they have differnt interfaces. Ok this not bad. The later interface (on testme object) call the value property. Normaly to call this property you have to know what to call, and as anyone expect  the VB6 compiler knows what to call, and place the code to do that, using the idispatch interface. Interfaces are choosen by the QueryInterface function (the first function on vtable). So why this not happen? Maybe the vtable isn't what expected because of casting. The solution was simple, I do manualy the casting to idispatch interface before using the Typename(vv.value) where vv is the object and value the property. The idea behind interfaces is that from any interface you can get any other interface if the object support it. You can't get a list of interfaces; You have to pass a 256bit number to find if supported. This number is to big. It is better to follow the code to find what compare...This is something for other time.


' The Bomb Situation, or you need a lifetime or more to understand how VB6
' I think this can't be found from AI


Cast =lambda (that$)->{
Interface that, that$ {dummy}
=lambda that (t as *that)->t
}
get_iUnknown = Cast("{00000000-0000-0000-C000-000000000046}")
' buffer object has functions to read memory everywhere;
' (checking for bad address first)
buffer inspect as long


declare form1 form
declare a type "ctxninebutton" form form1
testme = get_iUnknown(a)
? "These have different VTables"
vtable_a=inspect=>peekint32(varptr(a))
vtable_testme=inspect=>peekint32(varptr(testme))
? "Same Objects: ";testme is a
? "Different VTables: "; vtable_a<>vtable_testme
if version<15 or (version=15 and revision<29) then "do not do this - program hang": exit
? type(testme)
' why ? old one hang? Who knows..
' how overcame this problem?
' This problem was for the ExtControl class (see ExtControl.cls), the real class behind external controls.
' Type() didn't return ExtControl but go deeper and get the value property.
' This value property is the ctxninebutton (the usectxninebutton.ctl)
' So when we use Type(a) M2000 get the value of object and return ctxninebutton
' When we get the iUnkown interface, we get different Vbtable.
' That is not bad as idea, but for this control the use of value property hang the program.
' The solution was to get the iDispatch interface and then use on that the value property.


declare form1 nothing


Τρίτη 18 Αυγούστου 2026

Revision 26 Version 15

 New function Assembly():

' using assembly(code$) we get the machince code for running from the first offset
example1=Assembly({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
})
Declare Division Code example1(0) {long a, long b} as single
Print Division(34, 10)=3.4


' using assembly(code$, true) we get tuple, machinecode in a buffer and the object to get pointers from labels
(example1, Assembler)=Assembly({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
ASM_TEST_CPUID:
    ;mov eax, [esp+4]
    pushad ; 32 bytes
    xor eax, eax
    mov edi, [esp+36]
    xor eax, eax
    cpuid
    mov [edi+0], ebx
    mov [edi+4], edx
    mov [edi+8], ecx
    popad
    xor eax, eax
    ret 4
}, true)
Declare Division Code example1(0) {long a, long b} as single
Print Division(34, 10)=3.4
Dim Ret(12) as byte
addrPtr=Assembler=>LabelPtr("ASM_TEST_CPUID")
Hex "Call address of ASM_TEST_CPUID = ";addrPtr
Declare CPUID Code addrPtr {long ptrArrayItem}
call CPUID(VarPtr(Ret(0)))
' chr(number) return ansi string
for i=0 to len(Ret())-1
    Print chr(Ret(i));
next
Print
buffer clear retstring as byte*12
call CPUID(retstring(0))
' chr$(string_value) convert ANSI to UTF16LE
Print chr(retstring[0, 12])


Greek Version:

Παράδειγμα=ΚΩΔΙΚΑΣ({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
})
ΟΡΙΣΕ Διαίρεση ΚΩΔΙΚΑ Παράδειγμα(0) {ΜΑΚΡΥΣ α, ΜΑΚΡΥΣ β} ΩΣ ΑΠΛΟΣ
ΤΥΠΩΣΕ Διαίρεση(34, 10)=3.4


(Παράδειγμα1, Συνθέτης)=ΚΩΔΙΚΑΣ({
    fild  dword [esp+4]    ; st0 = numerator
    fild  dword [esp+8]    ; st0 = divisor, st1 = numerator
    fdivp                  ; st1 = st1 / st0, pop st0
    mov eax, 0    
    ret 8
ASM_TEST_CPUID:
    ;mov eax, [esp+4]
    pushad ; 32 bytes
    xor eax, eax
    mov edi, [esp+36]
    xor eax, eax
    cpuid
    mov [edi+0], ebx
    mov [edi+4], edx
    mov [edi+8], ecx
    popad
    xor eax, eax
    ret 4
}, ΑΛΗΘΕΣ)
ΟΡΙΣΕ Διαίρεση ΚΩΔΙΚΑ Παράδειγμα1(0) {ΜΑΚΡΥΣ Α, ΜΑΚΡΥΣ Β} ΩΣ ΑΠΛΟΣ
ΤΥΠΩΣΕ Διαίρεση(34, 10)=3.4
ΠΙΝΑΚΑΣ Επιστροφή(12) ΩΣ ΨΗΦΙΟ
Διεύθυνση_κλήσης=Συνθέτης=>LabelPtr("ASM_TEST_CPUID")
ΔΕΚΑΕΞ "Διεύθυνση κλήσης για το ASM_TEST_CPUID = ";Διεύθυνση_κλήσης
ΟΡΙΣΕ CPUID ΚΩΔΙΚΑ Διεύθυνση_κλήσης {ΜΑΚΡΥΣ ΔείκτηςΣεΣτοιχείοΠίνακα}
ΚΑΛΕΣΕ CPUID(ΔΙΕΥΘΜ(Επιστροφή(0)))
ΓΙΑ Ι=0 ΕΩΣ ΜΗΚΟΣ(Επιστροφή())-1
    ΤΥΠΩΣΕ ΧΑΡ(Επιστροφή(Ι));
ΕΠΟΜΕΝΟ
ΤΥΠΩΣΕ
ΔΙΑΡΘΡΩΣΗ ΚΕΝΗ επιστροφήΑλφαριθμητικό ΩΣ ΨΗΦΙΟ*12
ΚΑΛΕΣΕ CPUID(επιστροφήΑλφαριθμητικό(0))
ΤΥΠΩΣΕ ΧΑΡ(επιστροφήΑλφαριθμητικό[0, 12])




Κυριακή 16 Αυγούστου 2026

Revision 25 Version 15 Assembler x86 Upgrade

This is an example from the new assembler:

The first declare ..lib was not part of assembler. It is a way for M2000 to load and use a function from a dll. I made a new variant as declare ...code. The new variant get an address (the calling address). The old one get a dll name and a name for function or a cardinal number of function using #).

So the first declare make the function MessageBox() as M2000 function plus the name MessageBox as internal name (read only), for the address of the function. For this example we would like to call this function from the machine code. We need the address and the Hwnd value (the handler of current window, because we need the message box to be as a child window of our window). So @Hwnd and @MessageBox now can be used from assembler - Earlier version need a local variable to be used for each of these two. Names that are not known from assembler are looked as local variables. Also Assembler object need to be used after the call to obtain pointers from labels. See that Execute nee lassembler=>labeloffset( ), but Declare Code need assembler=>labelptr( )

Another difference from Execute is that functions can be pass any number of parameters. Execute get zero to 4  (always pass 4 long values), using the WindowProc internal function. Declare lib/code made functions called by DispCallFunc.

Function x86 called using Call Local. This place the caller scope as the callee scope. We need that because we have some local variables from the caller to be used as values from assembler.

You can see declare lib in SQLITE3 module in INFO which use c calls to handle sqlite3.dll. We can define the output variable (see the example which we define long long (int64)).

Although we make a signature for parameters, we can use the three points "..." for any number of parameters - c call. See Help Declare for this (Declare Global MyPrint Lib C "msvcrt.swprintf" { &sBuf$,  sFmt$, ... })

See also ASM4 in INFO file which saw the use of local variables in assembly plus the calling of M2000 code from the machine code.


Declare MessageBox Lib "user32.MessageBoxW" {long alfa, lptext$, lpcaption$, long type}
ASM_TEST = {    
start_code3:
push dword 2 | push dword mCaption | push dword mText |  push dword @HWND
Call @MessageBox
ret    
mText:          dw "HELLO THERE", 0
mCaption:       dw "GEORGE", 0
start_code4:  ; C call then StdCall
push dword [esp+16] | push dword [esp+16]
push dword [esp+16] | push dword [esp+16] ; copy arguments
Call @MessageBox
ret
start_code5:  ; StdCall -> StdCall
push dword [esp+16] | push dword [esp+16]
push dword [esp+16] | push dword [esp+16] ; copy arguments
Call @MessageBox
ret 16
}


Assembler=getobject("","m2000.x86")
function x86 (b as string, &outbuffer, useprep as boolean=false) {
if Assembler=>assemble(b, true) then
local OutPutSize=Assembler=>OutputSize
buffer code outbuffer as byte*OutputSize
Assembler=>BaseAddress = outbuffer(0)
if Assembler=>assemble(b) then
outbuffer=>FillDataFromMem Assembler=>GetOutPtr
else
error "x86 fault 2"
end if
else
error "x86 fault 1"
end if
}
var example1
call local x86(ASM_TEST, &example1)
Declare CallCode code c example1(0) As Long
Print CallCode()
' c call - by default ret value is long but here we place the type.
Declare MsgBox code c assembler=>labelptr("start_code4") {long alfa, lptext$, lpcaption$, long type} as long
Print MsgBox(hwnd, "This is the text", "This is the Caption", 2&)
wait 300
' stdcall
Declare MsgBox2 code assembler=>labelptr("start_code5") {long alfa, lptext$, lpcaption$, long type}
Print MsgBox2(hwnd, "This is the text", "This is the Caption", 2&)



Κυριακή 26 Ιουλίου 2026

Make Animation through Image Sequences (png files)

A small program written in M2000 produce in a folder a sequence of png files.

We can use Kdenlive to process the sequence as a video clip (we have to adjust th.e time for each image, we can give one video frame per image).



We apply a smart blurr effect to drop some pixels....


This is the code (included in zip file with the Orguss.png)

If not Exist("Orguss.png") then Error "Orguss.png not exit"
module SetFolder (that$) {
dir user
try ok {dir that$}
' if we don't have the folder we make it
if not ok then subdir that$
'we can delete any files or we overwrite them
' we send to two commands to cmd.exe
' with ";" we don't see the window of cmd.exe
' dos statement not work if we set a named user.
' so the named user if the folder exist can:
' 1) leave it and we get overwritten files or choose another name
' 2) change the export folder name.
dos "cd "+dir$+"  && del *.bmp";
}
module savePNG (file$) {
copy file$+".png"
}
module title.display (caption$, at as long=0, f$="ARIAL BLACK", sz as long=128){
module formlabel1 {
legend letter$, letter$, number, 0, number, 1
'formlabel letter$, letter$, number, number
}
move scale.x/2,at
Font.sizeY=size.y("|", f$, sz)
width 4 {
color {
formlabel1 caption$, f$, sz, 2
};
'move 0,at
'fill scale.x,Font.sizeY*2/3, 7,12, 0
move 0, Font.sizeY*2/3+at
fill scale.x, Font.sizeY/3, 11,3, 0

color {};
move scale.x/2, at
pen 0 {
color {
formlabel1 caption$, f$, sz, 2
}
}
}
}
module title.display (caption$, at as long=0, f$="ARIAL BLACK", sz as long=128){
module formlabel1 {
legend letter$, letter$, number, 0, number, 0
}

Font.sizeY=size.y("|", f$, sz)
move scale.x/2,at+Font.sizeY
width 4 {
color {
formlabel1 caption$, f$, sz, 2
};
move 0,at+Font.sizeY
fill scale.x,Font.sizeY*2/3, 7,12, 0
move 0, Font.sizeY*2/3+at
fill scale.x, Font.sizeY/3, 11,3, 0

color {};
move scale.x/2, at+Font.sizeY
pen 0 {
color {
formlabel1 caption$, f$, sz, 2
}
}
}
}
module title.displaY (caption$, at as long=0, f$="ARIAL BLACK", sz as long=128){
module formlabel1 {
legend letter$, letter$, number, 0, number, 0
}

Font.sizeY=size.y("|", f$, sz)
move scale.x/2,at+Font.sizeY/2
width 4 {
color {
formlabel1 caption$, f$, sz, 2
};
move 0,at
fill scale.x,Font.sizeY*2/3, 7,12, 0
move 0, Font.sizeY*2/3+at
fill scale.x, Font.sizeY/3, 11,3, 0
color {};
move scale.x/2, at
pen 0 {
color {
formlabel caption$, f$, sz, 2
}
}
}
}
Module SetSceenPixels (pixelsX, pixelsY) {
Layer {
font "courier new"
window 4, pixelsX*twipsX, pixelsY*twipsY;
mode 12
}
}


' here we set the current output the background layer,
' which is behind the console layer. The background layer is the form, the console window.
' Console window by default exgtend to full screen.
'window 12, 18000, 12000;
' window 12, window
oldfont$=fontname$
oldmode=mode
'SetSceenPixels 1280, 1024
SetSceenPixels 1024, 768
'SetSceenPixels 640, 480


' so now we make some loambda functions (they hide some state inside as closures)
(cX, cY, cfx, cfy, cfo)=lambda ->{
Back {
cls 0,0
MaxX=scale.x/1920/twipsX
MaxY=scale.y/1080/twipsY
OverAll=sqrt(scale.x*scale.y/1920/1080/twipsX/twipsY)
}
Data lambda MaxX (i)->{
=(8000+i*10)*MaxX
}
Data lambda MaxY (i)->{
=(5000+i*4)*MaxY
}
Data lambda MaxX (i)->{
=i*MaxX
}
Data lambda MaxY (i)->{
=i*MaxY
}
Data lambda OverAll (i)->{
=i*OverAll
}
=array([])
}() ' auto execute the lambda


' first we hide the console layer - not the form
Hide
Back {
' PREPARE BACKGROUND AND OBJECTS
' we make an emf file in a buffer (in memory only)

drawing 1920*twipsX, 1080*twipsY/2 {
title.display "ORGUSS", 0, ? ,?
title.display "Super Dimension Century Orguss", 3000, ?, 72

} as titles
' rendering emf file to a DIB in a string
t$="" : image titles to t$ (15), cfx(100) ' (15) make the not used pixel as white.
' some useful numbers
IY=Image.Y(t$)*2/3
M=100
a$=""
' now we read image orgus.png to a DIB in a string
' dib is the RGB only representation
' for this example we use Sprite statement with the simple DIB image.
' Although Sprite handle Orguss as is : Sprite Orguss, ...
image "Orguss.png" to a$
' we save the output to a temporary in memory place
' later we use Release to get it back
' so the backgroud can be restrored using Release, one statement only
' Now the background
cls 1, 0
move 0,0
fill scale.x, scale.y*3/5, 0,1,,1
move scale.x, scale.y*3/5
' we use a pen with 120/255 opacity, only for the circle
' we don't use FILL in Circle, but we use Color 14 { }
' so we get a filled circle file without outline
pen 14, 120 {color 14 {circle scale.y/1.5}}
move 0, scale.y*3/5
fill scale.x, scale.y*2/5, #aaccff, 4
hold
' now we move to standard user folder for M2000.
module SetFolder "export"
delay=1000/60
' delay 1 second for the next refresh or the next refresh statement, any came first.
refresh 1000
counter=0
i=1
' best use for animation is the every statement
every delay {
release
move scale.x/2, IY
if i>500 then sprite t$,15,,,M,1: M*=.98
move cx(i), cy(i)
sprite a$, #FF00FF, 30-i/30, cfo(i/5),,1
if i<500 then move scale.x/2, IY:Sprite t$, 15
savePNG "frame"+str$(counter,"000")
counter++
refresh 1000
i+=8: if i>1000 then exit
}
move cx(i)-cfx(180), cy(i)+cfy(90)
' we can use a for next and wait inside.
for k=1 to 100
release
sprite a$, #FF00FF, 30-i/30, cfo((i-k*12)/5),100-k,1
savePNG "frame"+str$(counter,"000")
counter++
step cfx(-180), cfy(90)
refresh 1000
wait delay
next
}
window 4, window
back {cls 0}
font oldfont$
Mode oldmode
dir user








orguss.zip