Παρασκευή 26 Μαΐου 2023

Convert BASIC to M2000 (Astronomy)

 

From BASIC PROGRAMS FROM SKY & TELESCOPE  we can convert some programs to M2000

Original program: ROCKET.BAS

We have to make a simple Print_Using statement for one parameter V displayed with the format in A$. Also we have to make LOG(), SQR(), EXP() and STRING$() to be same as BASIC. LOG() in M2000 return decimal logarithm, and LN() return natural logarithm.

Also at INPUT statement, M2000 never use ? if we use a string label so we can use ? and a space at each input label (here we have only one).

MODULE PRINT_USING (A$, V) {
B$=LEFTPART$(A$,"#")
C$=STRREV$(LEFTPART$(STRREV$(A$),"#"))
D$=MID$(A$, LEN(B$)+1, LEN(A$)-LEN(B$)-LEN(C$))
D1=LEN(RIGHTPART$(D$,"."))
D2=-LEN(D$)
PRINT FORMAT$(B$+"{0:"+D1+":"+D2+"}"+C$, V)
}
DEF LOG(X)=LN(X)
DEF SQR(x)=SQRT(x)
DEF EXP(x)=2.7182818284**x
DEF STRING$(A,B$)=@STRING$(B$,A)
10 REPORT "ROCKET.BAS by Brian Tung"
20 REPORT "ADAPTED FOR M2000"
30 REM
40 A=1.032: REM Earth gravity in light-years per year squared
50 INPUT "Distance in light-years (0-100 million)? "; D
60 IF D>=0 AND D<=100000000 THEN 80
70 PRINT "Distance must be between 0 and 100 million l-y": GOTO 50
80 D1=D/2
90 T=SQR(D1*D1+(2*D1/A))
100 X=A*T
110 M=1: REM Lines 110-180 compute inverse sinh
120 IF X<0 THEN M=-1
130 S=LOG(ABS(X)+1)
140 S1=S+1
150 X1=(EXP(S)-EXP(-S))/2-ABS(X)
160 S1=X1/(EXP(S)+EXP(-S))/2
170 S=S-S1
180 IF ABS(S1)>.0000001 THEN 150
190 T1=1/A*S*M
200 V=A*T/SQR(1+(A*T)*(A*T))
210 PRINT_USING "Time on Earth: #########.### years", 2*T
220 PRINT_USING "Time on board: #########.### years", 2*T1
230 Z$ = "Top speed: #.###"
240 IF D<1 THEN 280
250 Z1=INT(2*LOG(D)/LOG(10))
260 IF D>=1 AND D<10000000 THEN Z$=Z$+STRING$(Z1, "#")
270 IF D>=10000000 THEN Z$=Z$+"#############"
280 Z$=Z$+" c"
290 PRINT_USING Z$, V
300 END
900 REM ---------------------------
910 REM APPEARED IN COMPUTERS IN
920 REM ASTRONOMY, SKY & TELESCOPE,
930 REM FEBRUARY 2002, PAGE 66
940 REM ---------------------------

Another program is the LOOKBAK2.BAS

Because this program use wide display (80 characters at least) we can make console to use a 80X32 display, full screen. Also it is best to use Courier New font for editor/screen.

Also except for PRINT_USING, LOG() and SQR() was another problem. The original program use IF expr GOTO number statement, so the GOTO change to THEN. M2000 can use IF expr THEN GOTO numeric/alphanumeric label, or IF expr THEN numeric label. Also numeric labels can be from 0 to 99999 (5 digits max), but alphanumeric can be any size. We can use 010 for numeric labels (leading zeros). Also the order isn't mandatory, we may have 1000 previous of 500.


When we have to input a number like .35 we have to place like this 0.35 because the input statement in M2000 need sign or number as first character for numeric input. Numeric input always use the LOCALE sign for decimal point, and we have to use keyboard "." and we see comma for locale 1032 and dot for locale 1033. If we input more than one value, like Input A, B, C we can use keyboard comma as enter to enter next value, or just enter, in any case se will see a comma and a space and then the new input begin.

// we define A as string, so we have string input
String A: Input "number? ", A: Print A
Clear  // clear variables
// this is a numeric Input because A not exist and defined as Double type
Input "number? ", A: Print A
// A$ is string by default
Input "string? ",A$: Print A$
Clear
// using variant type
Variant A="ok"
Input "string? ", A: Print A, Type$(A)
A=100 // Variant can change type on assign
Input "number? ", A: Print A, Type$(A)



This is the program with the M2000 code

MODULE PRINT_USING (A$, V) {
B$=LEFTPART$(A$,"#")
C$=STRREV$(LEFTPART$(STRREV$(A$),"#"))
D$=MID$(A$, LEN(B$)+1, LEN(A$)-LEN(B$)-LEN(C$))
D1=LEN(RIGHTPART$(D$,"."))
D2=-LEN(D$)
PRINT FORMAT$(B$+"{0:"+D1+":"+D2+"}"+C$, V)
}
DEF LOG(X)=LN(X)
DEF SQR(x)=SQRT(x)
FONT "COURIER NEW"
FORM 80, 32
ITALIC 1
REPORT 2, {LOOKBAK2.BAS - May 2001; Updated Sept. 2003}
ITALIC 0
REPORT {APPEARED IN COMPUTERS IN ASTRONOMY,
SKY & TELESCOPE, AUGUST 2001, PAGE 62.
Corrections made Sept. 2003 to lines 232, 550, and 630, with
many thanks to Bruce Nelson, a great mathematician whose hobby
is cosmology and who decided to re-derive all these equations!
The updates give smoother results when OMC is small and more
accurate results for HT and ST for very large values of Z.


}
100 REM LOOKBAK2.BAS - May 2001; Updated Sept. 2003
110 REM by Thomas A. Weil, taweil@aol.com
112 REM Now handles user-specified values for both OmegaM and OmegaL.
114 REM Includes some code from Ned Wright's Cosmology Calculator,
116 REM http://www.astro.ucla.edu/~wright/CosmoCalc.html
120 INPUT "Enter Matter Density of the universe, OmegaM (0 - 2.0):"; OMG
130 IF OMG<0 OR OMG>2 THEN 120
140 INPUT "Enter Cosmological Constant, OmegaL (0. - 1.0):"; LAM
150 IF LAM<0 OR LAM>1 THEN 140
160 INPUT "Will you enter (A)ge of the universe or (H)ubble constant:"; AH$
170 IF AH$="H" OR AH$="h" THEN 210
180 IF AH$<>"A" AND AH$<>"a" THEN 160
190 INPUT "Enter Age of the universe NOW in billions of years:"; TN
200 TN=TN*1E+09 : HN=60 : M=8 : GOTO 220
210 INPUT "Enter Hubble constant in km/sec/Mpc:"; HN : M=1
212 REM N is the number of iterations to be used in each FOR-NEXT.
214 REM Ned Wright's Cosmology Calculator uses N=1000, but N=200
216 REM is faster and still seems to be quite accurate.
218 REM HFAC converts the Hubble constant to units of km/sec/Mpc from speed
219 REM as a fraction of the speed of light per light year of distance.
220 N=200 : DELTA=.0000001 : HFAC=9.7782E+11 : E=2.718282 : PARSEC=3.2616
222 REM For user-specified TN, we now calculate HN, but since ORD depends
224 REM on HN, we need to iterate AgeFac until the results converge.
226 REM AgeFac is the factor to multiply the inverse of the Hubble
228 REM constant by to determine the age of the universe.
230 FOR J=1 TO M
232 REM OMC is Omega(Curvature); OMC=0 gives us a "flat" universe.
234 REM ORD is Omega(Radiation), which is radiation pressure, which was a
236 REM major contributor to expansion when the universe was very young.
240 ORD=.4165/(HN*HN) : OMC=1-OMG-LAM-ORD : Z=5 : AZ=1/(1+Z) : AA=0
242 REM Calc. age at redshift Z, and lookback time, and add them to get Age
244 REM Now (TN). For this calculation we assume Z=5, but any value would do.
250 TRS=0 : TLB=0 : FOR I=1 TO N : A=AZ*(I-.5)/N : AA=AZ+(1-AZ)*(I-.5)/N
260 TRS=TRS+1/SQR(OMC+(OMG/A)+(ORD/(A*A))+(LAM*A*A))
270 TLB=TLB+1/SQR(OMC+(OMG/AA)+(ORD/(AA*AA))+(LAM*AA*AA)) : NEXT I
280 AGEFAC=TLB/N*(1-AZ)+TRS/N*AZ
290 IF AH$="H" OR AH$="h" THEN 310
300 HN=AGEFAC/TN*HFAC
310 NEXT J
320 TN=AGEFAC/HN*HFAC
330 INPUT "Will you enter (T)ime THEN or (R)edshift of the light we see NOW:"; TR$
340 IF TR$="R" OR TR$="r" THEN 470
350 IF TR$<>"T" AND TR$<>"t" THEN 330
360 INPUT "Enter Age of the universe THEN, in billions of years:"; TTT
370 TTT=TTT*1E+09 : IF TTT>299999 THEN 410
380 PRINT
390 PRINT " You cannot see back to a time earlier than about 300,000 years"
392 REM My first article in S&T, Sept. 1997, page 59, explains why.
400 PRINT : GOTO 330
410 PRINT " Finding what redshift matches Age THEN ......" : Z=(TN-TTT)/TN
420 AZ=1/(1+Z) : TRS=0 : FOR I=1 TO N : A=AZ*(I-.5)/N
430 TRS=TRS+1/SQR(OMC+OMG/A+ORD/(A*A)+LAM*A*A) : NEXT I
440 TT=TRS/N*HFAC/HN*AZ : TOL=TOL+DELTA
450 IF TT/TTT>1-TOL AND TT/TTT<1+TOL THEN 480
452 REM If Time Then (TT) doesn't match yet, adjust Z accordingly
460 Z=Z*(.2+.8*TT/TTT) : GOTO 420
470 INPUT "Enter redshift value for the light we see NOW:"; Z
472 REM Calculate Distances
480 DCMR=0 : AZ=1/(1+Z) : FOR I=1 TO N
490 A=AZ+(1-AZ)*(I-.5)/N : ADOT=SQR(OMC+(OMG/A)+(ORD/(A*A))+(LAM*A*A))
500 DCMR=DCMR+1/(A*ADOT) : NEXT I
510 DCMR=(1-AZ)*DCMR/N : X=SQR(ABS(OMC))*DCMR : IF X<=.1 THEN 550
520 IF OMC>0 THEN 540
530 RATIO=SIN(X)/X : GOTO 580
540 RATIO=.5*(E^X-E^(-X))/X : GOTO 580
550 Y=X*X : IF OMC>=0 THEN 570
560 Y=(-Y)
570 RATIO=1+Y/6+Y*Y/120
580 DL=AZ*RATIO*DCMR/(AZ*AZ)*977.82/HN : DN=DL/(1+Z) : DT=DN/(1+Z)
582 REM Calculate Time Then (TT) at redshift Z
590 AZ=1/(1+Z) : AGE=0 : FOR I=1 TO N
600 A=AZ*(I-.5)/N : AGE=AGE+1/SQR(OMC+OMG/A+ORD/(A*A)+LAM*A*A) : NEXT I
610 TT=HFAC/HN*AZ*AGE/N : TV=TN-TT : DMOD=5*.4343*LOG(DL*1E+09/(10*PARSEC))
620 IF TT<300000 THEN 380
630 HT=HN*SQR(OMG*(1+Z)^3+(1-OMG-LAM-ORD)*(1+Z)^2+LAM+ORD*(1+Z)^4)
640 ST=HT*DT/977.82 : SC=Z+1 : SN=HN*DN*1E+09/HFAC
650 PRINT_USING "Age Factor NOW  (Age=Fac/H0) = ##.####",AGEFAC
660 PRINT_USING "Age of the universe NOW  =####.#### billion years", TN/1E+09
670 PRINT_USING "Age of the universe THEN =####.#### billion years", TT/1E+09
680 PRINT_USING "Light travel time        =####.#### billion years", TV/1E+09
690 PRINT_USING "Redshift of the light we see NOW      =#####.###", Z
700 PRINT_USING "Scale of the universe NOW versus THEN =#####.###", SC
710 PRINT_USING "Distance of object THEN =  #####.### billion light-years", DT
720 PRINT_USING "Distance of object NOW  = ######.### billion light-years", DN
730 PRINT_USING "Luminosity Distance NOW =#######.### billion light-years", DL
740 PRINT_USING "Distance Modulus     = ######.###", DMOD
750 PRINT_USING "Speed away from us THEN =####.### x speed of light*", ST
760 PRINT_USING "Speed away from us NOW  =####.### x speed of light*", SN
770 PRINT_USING "Hubble constant THEN   =########.## km/sec/megaparsec", HT
780 PRINT_USING "Hubble constant NOW    =########.## km/sec/megaparsec", HN
790 PRINT " * Not the object's own speed, but caused by the expansion of space."
800 END
900 REM ---------------------------
910 REM APPEARED IN COMPUTERS IN ASTRONOMY,
920 REM SKY & TELESCOPE, AUGUST 2001, PAGE 62.
930 REM Corrections made Sept. 2003 to lines 232, 550, and 630, with
932 REM many thanks to Bruce Nelson, a great mathematician whose hobby
934 REM is cosmology and who decided to re-derive all these equations!
936 REM The updates give smoother results when OMC is small and more
938 REM accurate results for HT and ST for very large values of Z.
940 REM ---------------------------
950 REM ** SAMPLE RUN, for OmegaM=.35, OmegaL=.65, H0=61, and Z=1.7 **
960 REM Enter Matter Density of the Universe, OmegaM (0 - 2.0)? .35
970 REM Enter Cosmological Constant, OmegaL (0. - 1.0)? .65
980 REM Will you enter (A)ge of the universe or (H)ubble constant? H
990 REM Enter Hubble constant in km/sec/Mpc? 61
1000 REM Will you enter (T)ime THEN or (R)edshift of the light we see NOW? R
1010 REM Enter redshift value for the light we see NOW? 1.7
1020 REM Age Factor NOW (Age=Fac/H0) = 0.9226
1030 REM Age of the universe NOW = 14.7887 billion years
1040 REM Age of the universe THEN = 4.0054 billion years
1050 REM Light travel time = 10.7833 billion years
1060 REM Redshift of the light we see NOW = 1.700
1070 REM Scale of the universe NOW versus THEN = 2.700
1080 REM Distance of object THEN = 6.292 billion light-years
1090 REM Distance of object NOW = 16.987 billion light-years
1100 REM Luminosity Distance NOW = 45.865 billion light-years
1110 REM Distance Modulus = 45.741
1120 REM Speed away from us THEN = 1.078 x speed of light*
1130 REM Speed away from us NOW = 1.060 x speed of light*
1140 REM Hubble constant THEN = 167.55 km/sec/megaparsec
1150 REM Hubble constant NOW = 61.00 km/sec/megaparsec
1160 REM * Not the object's own speed, but caused by the expansion of space.


Last is the PRINT_USING statement for multiple numeric values:

The PRINT_USING module get these "A=#####.##ms B=##.##sec c=###%", 1, 1.3, 12.4 and execute a compiled code (through INLINE statement), identical to:

PRINT FORMAT$("A={0:2:-8}ms B={1:2:-5}sec c={2:0:-3}%",1, 1.3, 12.4)

but instead to convert numeric to string and then convert back to  number, we change the parameter list with NUMBER for each numeric parameter. 

PRINT FORMAT$("A={0:2:-8}ms B={1:2:-5}sec c={2:0:-3}%",NUMBER, NUMBER,  NUMBER)

The NUMBER identifier used to pop a number from stack of values. So when we call PRINT_USING we get the string value by a READ A$ statement (which place automatic from Interpreter) and then leave other values on stack for getting them later by using NUMBER. When we finish with INLINE statement we perform a FLUSH statement which make stack empty. So if we place more values which the format string can't process, then these erased. If we place less then a Number find empty stack and this raise error.  If we place a string in place of a number we get error too.

Format$() convert decimal point based on LOCALE, so LOCALE 1032 use comma, and LOCALE 1033 use dot. For source always decimal point is dot.


MODULE PRINT_USING (A$) {
DEF P,B$,B1$,C$
REPEAT
B1$=LEFTPART$(A$,"#")+"{"+P
B$+=B1$
A$=MID$(A$,LEN(B1$))
INTEGER D2=0, D1=0, I=1
WHILE MID$(A$,I,1)="#"
I++
END WHILE
D2=I
IF MID$(A$,I,1)="." THEN
D2++:I++
D1=0
WHILE MID$(A$,I,1)="#"
D1++
I++
END WHILE
D2+=D1
END IF
A$=MID$(A$,D2)
C$=LEFTPART$(A$,"#")
IF LEN(C$)=0 THEN C$=A$:A$=""
B$+=":"+D1+":-"+D2+"}"
P++
WHEN A$<>""
TRY OK {
INLINE "PRINT FORMAT$("+QUOTE$(B$+C$)+STRING$(", NUMBER", P)+")"
}
IF ERROR OR NOT OK THEN C$=ERROR$: ERROR "PROBLEM ON PARAMETERS"
FLUSH // DELETE MORE VALUES
}
PRINT_USING "A=#####.##ms B=##.##sec c=###%", 1, 1.3, 12.4
PRINT FORMAT$("A={0:2:-8}ms B={1:2:-5}sec c={2:0:-3}%",1, 1.3, 12.4)


Πέμπτη 25 Μαΐου 2023

Revision 31, Version 12

 All bugs removed; GreekManual.pdf updated (all programs checked)..


Fixed one line problem on pipe thread (so now run as expected)

\\ Server - Client in one module
\\ The easy way. ALFA$ is cleared
\\ L=12345   \\ here we use an auto thread number.
USE PIPE TO ALFA$ AS L
PIPE PIPENAME$(L),"George",2,3
WHILE ALFA$="" {
      IF MOUSE THEN BREAK   \\EXIT FROM MODULE
      WAIT 10
      PRINT "Wait..."
}
STACK ALFA$ : DROP 2 \\ drop pipe name and match string
READ A$, A, B
PRINT A$, A, B
THREAD L ERASE
THREADS

Fixed an old bug: When we merge an object with another, we expect the final object to handle private properly. The Group C as part of beta class has to read private x from parent, using the proper link statement, The following  example now run as expected. Some earlier versions also works, but from version 11, middle revisions that broken. This example founded as Greek version on GreekManual. This show how to add temporary functionality to an object. The easiest way is to use a function and not a group which is one level down from objects first level members. Using a function we don't have to use the link statement for the previous level (this can be used only on functions/modules which are members of an object, which is member of an object (as compound object, not by inheritance, and not by a pointer, this object is part of the host object, and is read only, as executable object, and we can add more functions/modules/members/events)

class alfa {
private:
    x=1234
public:
    module ShowX {
        Print .x
    }
}
class beta {
    k=30
    group c {
        value {
            link parent x to x
            =x
            x++
        }
    }
}
m=alfa()


module tstA (&z) {

    // attach beta class on z, where z.c get private z.x (which is )
    // z has own list, so the m hold integrity of own list of members
    z=beta()
    Print z.c // should be 1234  and private x change to 1235. which part of m
}
// pass by reference
tstA &m
// c not exit in m
Print Valid(m.c)=false // should be True
m.ShowX  // should be 1235

Τρίτη 23 Μαΐου 2023

Αναθεώρηση 29, Έκδοση 12

 Ανανεώθηκε αρκετά το GreekManual.pdf, to ελληνικό μικρό εγχειρίδιο της Μ2000. Έγιναν και μερικές διορθώσεις από μικρά προβλήματα που δημιούργησε η αναθεώρηση 25 (ήταν εκτεταμένη αναθεώρηση).. Τα προβλήματα βρέθηκαν όταν δοκίμασα προγράμματα από το μικρό εγχειρίδιο, όπως αυτό:

Κατάσταση Αλφα ="ένα":=12345,"δύο":="Γεια","τρία","τέσσερα"
Κλάση Βήτα$ {
Ιδιωτικό:
      Κατάσταση Πιν
Δημόσιο:
      Αξία (κ$) {
            Δες Οκ {
                  =αυτό.Πιν$(κ$)
           }
           Αν Οκ τότε Έξοδος
          ="??"          
      }
Κλάση:
      Τμήμα Βήτα {
            Διάβασε ΚΚ
                   .Πιν<=ΚΚ
      }
}
Πίνακας Μ$(10)=Βήτα$(Αλφα)
Τύπωσε Μ$(3)("δύο")
Τύπωσε Μ$(3)("ένα")

Στο παραπάνω πρόγραμμα από την 25 αναθρώρηση της έκδοσης 12 έδινε το ?? ως αποτέλεσμα στις δυο τύπωσε στο τέλος. Τώρα δίνει τις τιμές που γυρνούν τα κλειδιά "δύο" και "ένα".

Στο παρακάτω πρόγραμμα, το Group kk$ γυρνάει τιμή και μπορεί να πάρει παραμέτρους, ενώ είναι ιδιωτικό. (και εδώ είχε σφάλμα που διορθώθηκε).

Οι δυο σειρές Print (Τύπωσε) στο τμήμα ShowMe, δεν έχουν διαφορά στην εμφάνιση τιμών, απλά στο πρώτο χρησιμοποιούμε το This ενώ στο δεύτερο έχουμε μόνο την τελεία.

Group Beta {
Private:
        Inventory pin="one":=12345,"two":="Hello","three","four"
        Function alfa$ {
                ="OK"
        }
        k=lambda ->"k1"
        Group kk$ {
                value () {
                        ="ok_kk"
                }
        }
Public:
        Module ShowMe(k$) {
                Try ok {
                        print this.pin$(k$), this.alfa$(), this.k(), this.kk$()
                        print .pin$(k$), .alfa$(), .k(), .kk$()
                }
                if not ok then print "nothing"
        }
}
Beta.ShowMe "two"
Beta.ShowMe "one"


Το τμήμα Comp_num (μιγαδικοί αριθμοί) τώρα τρέχει σωστά! Υπάρχει στο αρχείο info.gsb που περιέχεται στο πρόγραμμα εγκατάστασης.

https://github.com/M2000Interpreter/Environment/releases


Τρίτη 2 Μαΐου 2023

Revision 26 - Version 12

 A last correction for VBCollection module on info.gsb

Was a problem when we extract the _NewEnum object (which for vbCollection is of type IUnknown, which M2000 can't handle as is). Some older versions works fine but later a missing set of an object cause the return of a long variable and not Nothing, which is ok, because the actual object isn't of type IDispatch , so it's saved in a separete variable of type Variant, which can hold IUnkown objects, and all of that goes to a hidden mHandler object. So the fault revisions return long (and not the mHandler object).

So the revision 26 has only one new line of code: Set robj = usehandler in line 538, on mdllDispatch module.

Here is a simple program which we use the enum object Item (fault programs return Item as long with value 0 so the While Item not execute the following block of code.

declare c collection
Method c, "Add", 100
Method c, "Add", "Hello"
Method c, "Add", 300
Method c, "count" as count
Print count
Method C, "_NewEnum" as Item
List
Print type$(Item)="Nothing"
k=0
While Item {
      k++
      print k, eval(item)
}
Method C, "_NewEnum" as Item
Print type$(Item)="Nothing"
k=0
While Item {
      k++
      print k, eval$(item)
}