Assemble a DLL (Revision 40 Version 15)

Make a DLL. I use Gemini for my AI help. And PE-BEAR:

' example
' no use of Assembly() function  because we have to prepare Assembler first
' these are the steps to make a dll using 3 exported functions and one inported
' also this use relocarion table

name$="TESTASM7.DLL"
Static Function MachineCode
Enum PESubsystem {
    Subsystem_GUI = 2
    Subsystem_CUI = 3
}
Assembler =getobject("","m2000.x86")
Assembler=>Subsystem=Subsystem_GUI
Assembler=>PEDll=true 
Assembler=>DLLName = name$
Assembler=>AddExport "AddNumbers", "MyFunction"
Assembler=>AddExport "Time", "MyTime"
' we use a space so this sortrd to first place - ordinal 1
Assembler=>AddExport " 01", "MyTick"

Buffer2export=MachineCode({

extern "winmm", timeGetTime

; =========================================================================
; STANDARD WIN32 DLL ENTRY POINT (DLLMAIN)
; =========================================================================
DllMain:
    push ebp
    mov ebp, esp
    mov eax, 1
    leave
    ret 0xC

; =========================================================================
; EXPORTED FUNCTION (MyFunction to Addnumbers)
; =========================================================================
align 4
MyFunction:
    push ebp
    mov ebp, esp
    
    mov eax, dword [ebp + 8]   ; First parameter (a)
    add eax, dword [ebp + 0xC]  ; Second parameter (b)
    leave
;    mov esp, ebp ; same as leave
;    pop ebp
    ret 8                ; Clean up 2 arguments (2 * 4 bytes = 8) and return
    	
; =========================================================================
; EXPORTED FUNCTION (MyTime to Time)
; =========================================================================
	align 4
MyTime:
	call_ext timeGetTime   ; new directive for absolute call
	; so the code can be moved and the timeGetTime works fine
	ret

; =========================================================================
; EXPORTED FUNCTION (MyTick to #1 - no name)
; =========================================================================
	align 4 ; new directive for alignment
MyTick:
	call SomethingElse
	ret
align 16
SomethingElse:	
	push ebp
	mov ebp, esp
	mov eax, [data1]
	inc eax
	mov [data1], eax
	leave
	ret
data1:
	dd 0x20304050
})
Print "File name: ";name$
Print "Assembler Output Size: "; assembler=>outputsize
open name$ for output as #f
	put #f, Buffer2export
close #f
Print  "Saved ok. length:"; filelen(name$)
check$=file.name.only$(name$)
declare add2 lib dir$+check$+".AddNumbers" {long a, long b} as long
declare mytime lib dir$+check$+".Time" as long
' using ordinal number:
declare mytick lib dir$+check$+".#1" as long

try ok {
	? add2(1022322,22340) = 1022322+22340,  mytime(), mytick()
	? add2(1022322,-22340) = 1022322-22340,  mytime(), mytick()
	? add2(-1022322,22340) = -1022322+22340,  mytime(), mytick()
	? add2(10222,-2240) = 10222-2240, mytime(), mytick()
}
if ok then remove dir$+check$ else print error$

' this is the function for preparing the two pass assembler.

Function MachineCode(assembly as string)
	if Assembler=>assemble(assembly, true) then
		local OutPutSize=Assembler=>OutputSize
		local mc
		buffer code mc as byte*OutputSize
		' feed the base address to Assembler
		Assembler=>BaseAddress=&h10000000 		
		if Assembler=>assemble(assembly) then
			' get a copy of final machine code
			mc=>FillDataFromMem Assembler=>GetOutPtr
			=mc
			exit function
		End if
	End if
	error Assembler=>LastErrorMessage 
End Function

Synchronous concurrency

 https://rosettacode.org/wiki/Synchronous_concurrency#M2000_Interpreter

Synchronous concurrency is a task in rosettacode.

module TwoThreads {
	rem {
		For this example we split the screen to two layers
		the left layer is the bacic layer, no need to exclusive address it
		.. we can using Layer { }
		the right layer is Layer 1 we use this for print_unit
		Also, when we use threads we handle screen refresh using REFRESH
	}
	' M2000 Window: using current font size and current monitor full screen
	//	font "Arial"
	//	font "Courier"
	font "Courier new"
	window mode, window
	escape off ' code 27 now work on the main.task (using KEYPRESS(27))
	
	//	thread.plan sequential ' execute a thread and the switch to other thread
	thread.plan concurrent ' execute one statement and switch thread
	enum action {printline, returnline, closeall}
	var finish as boolean, p as long, current=printline
	const curscale.x=scale.x, curscale.y=scale.y, mx=motion.x, my=motion.y
	mode mode, scale.x/2,scale.y
	motion mx  ' set left property of layer to mx
	' prepare the input.txt (wide for UTF16LE) 
	open "input.txt" for wide output as #f
	for i=1 to 20
		print #f, string$("*", random(1, 30))
	next
	close #f
	layer 1{
		window mode, curscale.x/2, curscale.y
		motion mx+curscale.x/2, my
		pen 11
		cls 1
		show
		print $(,8),  ' set column width
		thread {
			Static lines2print=0&
			if not empty then
				if number=printline then
					lines2print++
					print lines2print, ". ";letter$ : refresh
				end if
			end if
		} as print_unit interval 50
	}
	print "done": refresh
	
	thread {
		if p else
			open "input.txt" for wide input as #p
		end if
		if current=returnline then
			thread print_unit execute finish=empty ' check stack of print_unit 
			if finish then
				thread print_unit execute {
					 Print "lines: ";lines2print
					 refresh	
				}
				thread print_unit erase
				threads  ' 2
				current++
			end if
		else.if eof(#p) then
			current++	
			close#p
		else
			line input #p, buffer$
			thread print_unit execute data printline, buffer$
		end if
	} as reading_unit interval 50
	' main.task is a thread also
	main.task 50 {
		if keypress(27) or current=closeall then exit
	//		threads ' number of threads
	}
	threads erase
	threads ' number of threads
	escape on	
}
TwoThreads

Revision 39 - Final revision of 15th Edition

Revision 39 is the final revision for Version 15. Only new revisions if I found bugs. No new additions for version 15. There is a final greek manual and I am starting the english one.

Ανανεώθηκε το εγχειρίδιο της 15ης έκδοσης

Το πιο νέο εγχειρίδιο. Έχω κάνει βελτιώσεις!

https://github.com/M2000Interpreter/Environment/releases/download/version15revision39/GreekManualVersion15.pdf

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
	Α$=ΚΟΜ$
ΤΕΛΟΣ ΡΟΥΤΙΝΑΣ

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