Κυριακή, 18 Αυγούστου 2019

Html Colors



A simple example just open M2000 interpreter, then write Edit A, paste this code, then press Esc, and write A and you get the results.

About program.
1. Module ShowColors is a module in module A. Function Title$() exist as string funcion, but here we make a user function (which hide the M2000 function, for this module). We can delete this function, because Title$() exist and have same behavior. Also we can change a M2000 function adding more parameters, or change the signature as we wish. Each inner module/function can be called only from code inside module. We can't call a sibling module/function, but we can make some modules or functions as global (module Global Inner { ... })

We can make two type of functions. The simple functions, and the lambda functions (see 2)

We call the Module ShowColors after we declare it, using its name. At calling M2000 pass the current stack of values in a process object, among the code of chosen Module. So the next statement after the call is a READ, which read from stack of values. A read statement can make variables. If a global variable exist with same name then a new local variable created. If a local variable exist then first the READ check the type of that variable and the type of the top value on stack and then if its ok do the read else raise an error. To read a global variable we have to use a line to line interpreter using Set, so a Set Read Alfa  read Alfa as a global variable (if exist assign value on it)

Module ShowColors has some parts. First is the function declaration of Tittles$(), then a Pen and a Cls (clear screen) set pen and background color. The next part make an Inventory, an object with keys and values. keys maybe numbers or strings (internal is always strings), and value can be anything (except simple functions and  modules, but we can create Groups which have functions and modules).

Before using Module ShowColors we have to delete all values from stack of values, or we can do this using a temporary stack STACK NEW { ShowColors :  ..... } and at the exit from the block we get the old stack, which preserve the Stack New { } block.

Here we use Flush to empty the stack. So the next part of Module ShowColors include some Data statements which place values to end of stack, so the first we place we read it first (FIFO). So to use the stack (which is a LIFO) as a FIFO we have to use Data  (using Push we use stack as LIFO). For this example we can change the DATA with PUSH, and we get the list in reverse order, but this isn't a problem.

The next part has two For loops. The first append 16 pairs to inventory list. The second print a list of list keys and use the value to change the color using a Pen color_value {} block which preserve at the exit the pen color before the use of Pen. We use the For Next and not For  { } block. We can use Next i or Next without variable name. A For always execute at least one (even with a zero step), at default behavior. We can change behavior using a  proper switch, where we get the For like this on Basic language). At default behavior we use absolute value of step, so a For I=16 to 1 step 1 { } call the block 16 times and i get value 0 at the end of the loop. In alternate behavior the sign used so we get no execution of block, and the I get 16 as value. From a module we can use Set Switches "+FOR" to set the BASIC type For (or "-FOR" to set the M2000 type of For).

2. The final part has two statements. We make a lambda function as css_c and we push the value of it on stack of values.

Creating the lambda function is easy. We have to use lambda clause (if the returned value isn't a string, or something which return a string, like another lambda function), After the lambda we can place any closure. The closure is a copy of  variable. but here the css_colors is an object pointer so we copy the pointer only. After the list of closures we can put a list of arguments (although this is a sugar code,  and the list of arguments is a Read statement as first statement in lambda function body. In M2000 all user functions except Event functions  have no signature for arguments, so we can pass anything and the Read statement can be raise the error, or we can read the types of stack and make whatever we want. In event functions because of multicast behavior (calling an event, which may have a list of functions, so multicasting means to passing to each function the same signature of parameters, as copies (including by reference parameters), so the signature checked before calling)

Inside lambda css_c we have a Try ok {} block. If we give a not exist key we get 0. Without the = statement (as first char) the function has the default Empty value. But we place a =0 before the try so we get the 0 as a double (or we can use =0& to return a long type, or 0%, for integer 16bit or 0@ dor decimal or 0# for currency or 0! for single float)
Look this example. k is a lambda but has no = statement. So the returned value is Empty. Variable N get the value Empty.

k=lambda -> {
}
N=k()
Print 1, 2, 3, 4
Print N, 0, k(), 1
Print N+1, N*1, Type$(N)="Empty"
we get  an empty column when we pass an Empty value, but Empty value is a 0 for calculations.

      1       2       3       4
               0                1
      1       0    True

3. So after the return from Module, all entities from Module deleted except the lambda function and inside this the inventory which kept as closure. We check this using some Print statements inside Pen {} statements.

4. Now we make another lambda function, which return a string, so we use lambda$. A lambda which return a string, if we don't provide a = statement we get an empty string (not empty value).

Here we pass a closure of another lambda. When this lambda execute the function body make three local variables, a$, clr and clr$. The two last have different names, the second one has a $ which also means that is a string.


5. One last thing
 For i=1 to 16
 Print i, :Pen css_colors(i-1!) {Print Title$(eval$(css_colors, i-1))}
 Next
An inventory has unique keys (except of the type of queue). If we delete a key then we loose the order of keys. We can sort the keys using the Sort statement. We can read a value using the name of inventory as a function. We can use the name of the inventory as a string function (using the $). So css_colors$("GRAY") return the number value as a string.
We can use the order of the key, using the ! after a number expression, where 0 is the first element. So we give css_color(ii-1!) to get values from 0 to 15. We can get the name of key using the ordinal number, using Eval$(css_color, i-1)

To find the ordinal number of a key we can use this (4th-1=3):
 If exist(css_colors,"WHITE") Then Print eval(css_colors, !)=3

The inventory deleted when the last pointer for it also deleted. The closure css_c is a copy, but has a copy of the pointer of the inventory. M2000 Interpreter delete the variables from the last, so first delete the ExportCssColor$() which delete it closure css_c which delete it closure css_colors (because there is another pointer to inventory, the inventory still exist). After that delete the css_c which delete the css_color closure, which release the inventory because it is the last pointer.



6. The code (put it in a Module)

Flush ' Empty the stack of values
Module ShowColors {
 Function Title$(a$) {
  =Ucase$(left$(a$,1))+Lcase$(mid$(a$,2))
 }
 Pen 14
 Cls #A0A022
 Print "CSS COLORS"
 \\ CSS colors
 inventory css_colors
 Data "BLACK", #000000, "SILVER", #C0C0C0
 Data "GRAY", #808080, "WHITE",  #FFFFFF
 Data "MAROON", #800000, "RED", #FF0000
 Data "PURPLE", #800080, "FUCHSIA", #FF00FF
 Data "GREEN", #008800, "LIME", #00FF00
 Data "OLIVE", #808080, "YELLOW", #FFFF00
 Data "NAVY", #000080, "BLUE", #0000FF
 Data "TEAL", #008080, "AQUA", #00FFFF
 For i=1 to 16: Append css_colors, letter$:=number: Next
 For i=1 to 16
 Print i, :Pen css_colors(i-1!) {Print Title$(eval$(css_colors, i-1))}
 Next
 
 css_c=lambda css_colors (a$) -> {
  =0
  Try ok {
   =css_colors(Ucase$(a$))
  }
 }
 Push css_c 
}
ShowColors
Read css_c
Pen css_c("Navy") {Print "Navy";string$("-", width-4);}
Pen css_c("Lime") {Print "Export html color from name"}
ExportCssColor$= lambda$ css_c (a$) -> {
 clr=css_c(a$)
 clr$=hex$(clr, 3)
 =Right$(clr$, 2)+Mid$(clr$, 3,2)+left$(clr$,2)
}
Print "Aqua = #"+ExportCssColor$("Aqua")
Print "Red = #"+ExportCssColor$("Red")
Print "Gray = #"+ExportCssColor$("Gray")

Κυριακή, 11 Αυγούστου 2019

New certificate for binaries

Binaries updated with new certificate. Also info.gsb updated with the new Banker algorithm.

When the installation of M2000.exe  and M2000.dll done, you can insert the M2000.cer as a trust root certificate. All binaries have another certificate which chain to the root certificate.


New Banker Algorithm

I fixed the banker algorithm. Now includes two more examples, to display a safe and an unsafe state.



\\ No2
\\ First publish in Rosetta.org
\\ http://www.rosettacode.org/wiki/Banker%27s_algorithm#M2000_Interpreter
Module BankerAlgo {
      Form 80, 44
      Cls 5
      Pen 14
      Function Request(FromWhere as Inventory, What$, Many as long)  {
            =FromWhere(What$)-FromWhere(What$+"_Request")-Many>=0
      }
      Function RequestPreset(FromWhere as Inventory, What$, Many as long)  {
            =FromWhere(What$+"_Request")-Many>=0
      }
      Function Need(FromWhere as Inventory, What$, Many) { 
            =FromWhere(What$ + "_max")-FromWhere(What$)-Many>=0
      }
      \\ code for sub can be found from parent module/function (here parent as in code, not as in call)
      Function NewProcess {
            Inventory Process
            ApplyResources(Process)   ' sub need more arguments and read from current stack
            =Process
      }
      Inventory System, Processes 
      \\ Recource, Max, Available
      ApplyResources(System, "A", 6, 3,"B", 5,1,"C", 7, 1, "D", 6, 2)
      \\ Recource, Max, Available
      Append Processes, "P1":=NewProcess("A", 3, 1, "B", 3, 2, "C", 2, 2, "D", 2,1)
      Append Processes, "P2":=NewProcess("A", 1, 1, "B", 2, 0, "C", 3, 3, "D", 4,3)
      Append Processes, "P3":=NewProcess("A", 1, 1, "B", 3, 2, "C", 5, 1, "D", 0,0)
      Status(True) ' show all process, available resource and max
      SafeState=True
      Print "Current Status"
      RequestResource() ' display Safe State
      RequestResource("P2", "D", 1) ' display Safe State
      RequestResource("P1", "A", 1, "D", 1) ' display Safe State
      RequestResource("P1", "C", 1, "D", 1) ' display Too many resources ...
      RequestResource("P2", "B", 1) ' display Unsafe State
      RequestResource("P3", "C", 1)  ' display Safe State
      Status()
      \\ Second Example
      Clear System, Processes
      ApplyResources(System, "A", 10, 3)
      Append Processes, "P1":=NewProcess("A", 9, 3)
      Append Processes, "P2":=NewProcess("A", 4, 2)
      Append Processes, "P3":=NewProcess("A", 7, 2)
      Status(True) ' show all process, available resource and max    
      Print "Current Status"
      RequestResource() ' display Safe State
      \ Third Example
      Clear System
      ApplyResources(System, "A", 10, 2)
      Return  Processes,"P1":=NewProcess("A", 9,4)
      Status(True) ' show all process, available resource and max    
      Print "Current Status"
      RequestResource() ' display UnSafe State       
      Sub Respond()
            If SafeState Then {
                  Pen 15 {Print "Safe State"}
            } Else Pen 13 {Print "Unsafe State"}
      End Sub
      Sub WaitForKey()
            Pen 11 {Print "Press a key"}
            local a$=key$
      End Sub
      Sub RequestResource(ProcessName$="" )
            SafeState=True
            If ProcessName$="" Then CheckNewState(&SafeState) : Respond() : Print : WaitForKey():Exit Sub
            Local pro=Processes(ProcessName$), ResourceName$, many as long
            ClearAllRequest(pro)
            Local skip=False
            While Match("SN") {
                  Read ResourceName$, many
                  Print  Format$("Claim {1} for type {0} resource ",ResourceName$, many)
                  If skip Then Continue
                  If Request(System, ResourceName$, many) Then {
                        If Need(pro, ResourceName$, many) Then { 
                              Return pro, ResourceName$+"_Request":=many
                              Return System, ResourceName$+"_Request":=-many
                        } Else {
                              Print "Too many Recources "+ResourceName$+" for Process "+ProcessName$  : Skip=True
                        }
                  } Else Print "Too many Recources for System" : Skip=True
                  If Skip Then exit
            } 
            If skip Else  CheckNewState(&SafeState) : Respond()
            Print  ' just a new line
            WaitForKey()
      End Sub
      Sub ApplyResources(Where as Inventory, What$, MaxValue, InitialValue)
            Repeat {
                  If Not Exist(Where, What$) Then {
                        Append Where, What$:=InitialValue, What$+"_max":=MaxValue, What$+"_Request":=0
                  }
                  If not Match("SNN") Then Exit
                  Read What$, MaxValue, InitialValue
            }  Always
      End Sub
      Sub ClearAllRequest(Where  as Inventory)
            Local M=Each(Where)
            While M {
                  If Instr(Eval$(M, M^),"_")=0 Then {
                        Return Where, Eval$(M,M^)+"_Request":=0
                  }
            }
      End Sub
      Sub PrintResources(Where  as Inventory)
            Local M=Each(Where)
            While M {
                  If Instr(Eval$(M, M^),"_")=0 Then Print Eval$(M, M^)+"="+Eval$(M),
            }
            Print
      Exit Sub
      Sub PrintMax(Where  as Inventory)
            Local M=Each(Where)
            While M {
                  If Instr(Eval$(M, M^),"_max")>0 Then Print LeftPart$(Eval$(M, M^), "_")+"="+Eval$(M),
            }
            Print
      Exit Sub
      Sub Status(Ok as boolean=False)
            Print "Total System Resources"
            PrintMax(System)
            Print "Available Resources in System"
            PrintResources(System)
            If Not Ok Then WaitForKey(): Exit Sub
            Local  M=Each(Processes)
            While M {
                  Print "Process "+Eval$(M, M^)
                  PrintResources(Processes(M^!))  ' give index M^ as Key index number (using !)
                  Print "Maximum Resources for "+Eval$(M, M^)
                  PrintMax(Processes(M^!))
            }
      End Sub
      Sub CheckNewState(&Ok)
            local M=Each(Processes), M1, count=len(Processes), alive(0 to count-1)=1
            Local Z, Recource$, safe as boolean=false
            While count {
                  safe=false
                  While M {
                        If alive(M^) Then {
                              Z=Processes(M^!)
                              M1=Each(Z) 
                              safe=True 
                              While M1 {
                                    Recource$=Eval$(M1, M1^)
                                    If Instr(Recource$,"_")=0 Then {
                                         safe=System(Recource$)+System(Recource$+"_Request") >= Z(Recource$ + "_max") - Z(Recource$)-Z(Recource$ + "_Request")
                 }
                                    If not safe Then exit
                              }
                              If safe Then {
                                    print format$("Process {0} is executing", M^+1)
                                    alive(M^)=0
                                    count--
                                    M1=Each(Z) 
                                    While M1 {
                                          Recource$=Eval$(M1, M1^)
                                          If Instr(Recource$,"_")=0 Then {
                                                Return System, Recource$+"_Request":= System(Recource$+"_Request") + Z(Recource$) + Z(Recource$+"_Request")
                                                Return Z, Recource$+"_Request":=0
                                          }
                                    }
                              }
                        }
                  }
                  If safe Else exit
            }
            Ok=safe
            ClearAllRequest(System)
      End Sub
}
BankerAlgo

Παρασκευή, 9 Αυγούστου 2019

Προγράμματα στη ΓΛΩΣΣΑ της ΑΕΠΠ

Συγκέντρωσα τα προγράμματα σε ΓΛΩΣΣΑ που έχω αναρτήσει στο  Στέκι των Πληροφορικών
Προχωρημένα προγράμματα στη ΓΛΩΣΣΑ της ΑΕΠΠ 


Υπάρχουν και άλλα προγράμματα που έγραψα στο SpiNet και ειδικότερα στο Ασκησιολόγιο με το ίδιο ψευδώνυμο Bugman. Το πρόβλημα στα προγράμματα του Ασκησιολογίου είναι στη διαφοράτης Γλώσσας που την εποχή εκείνη υλοποιούσε η Γλωσσομάθεια, ο μεταφραστής της γλώσσας.
Ανέβασα στο Στέκι το Mastermind τροποποιημένο για τον διερμηνευτή της Γλώσσας.  Εδώ εκμεταλλεύομαι τη συνένωση αλφαριθμητικών που έχει ως επιλογή ο διερμηνευτής.

Πέμπτη, 8 Αυγούστου 2019

Αυγουστιάτικες Καταστροφές!

Τα κακά νέα!
Πριν δυο μέρες χάλασε ο βασικός μου υπολογιστής. Μάλλον έχει καεί η CPU (AMD 6100 FX). Οι σκληροί δίσκοι είναι εντάξει, και επειδή το βασικό σύστημα είναi Ubuntu 64bit, αρκεί να πάρω ένα νέο motherboard με ένα 64bit επεξεργαστή και το σύστημα θα δουλέψει ξανά. Λόγω όμως της μετακόμισης στην Αθήνα, μάλλον θα αργήσω να προβώ σε αγορά!

Τα καλά νέα!
Έχω ένα παλιό λάπτοπ χωρίς οθόνη (είναι μόνο το ένα μέρος, το πληκτρολόγιο!). με AMD Sempron (32bit), μ68ε XP και με Windows 7, και προς το παρόν έχει μόνο 768 MByte Ram., και το έβαλα στη θέση του χαλασμένου υπολογιστή!

Βρήκα ότι ο UC Browser, λειτουργεί καλύτερα, για μικρή μνήμη. http://www.ucweb.com/desktop/ ο οποίος χρησιμοποιεί μια παλαιότερη μηχανή του Chrome, βελτιστοποιημένη.

Σχετικά με τη Μ2000:
Στον παλιό υπολογιστή έβαλα την VB6 και την SP6 αναβάθμισή της (σε λειτουργικό Windows 7) και διόρθωσα ένα λάθος στο repo της Μ2000 στο GitHub, ένα αρχείο (το  RecDir.Cls) ήταν σε παλαιότερη έκδοση, με συνέπεια να μην γίνεται compile το dll της Μ2000.

Κατέβασα το GitKraken ως git client. Το πρώτο πρόβλημα που βρήκα ήταν ότι δεν έβγαζε εικονίδιο για εκτέλεση! Τελικά πρέπει κανείς να ανοίξει αυτό %localappdata%\gitkraken  και να επιλέξει το φάκελο app-6.0.1  (ή όποιο άλλο νούμερο του δίνει) από όπου θα φτιάξει μια συντόμευση για το gitkraken.exe. Με χρήση αυτού του προγράμματος ανέβασα στο github το νέο αρχείο του RecDir.Cls.

Στην αρχή βγαίνει ένα εικονίδιο, και αργεί λίγο να φορτώσει (αλλά τρέχει σε 32bit).

Και μετά ανοίγει μια σελίδα όπως αυτή (έχει ήδη το κωδικό μου για να συνδέεται με το GitHub).


Εγκατάσταση VB6.
Χρησιμοποίησα το WinCDemu για να βάλω το ISO της VB6 σε εικονικό CD. Το καλό με αυτό το πρόγραμμα είναι ότι συνδέει πάλι το εικονικό CD σε περίπτωση επανεκκίνησης.
Η VB6 είναι η Enterprise Edition. Πρέπει να αναβαθμιστεί σε Service pack 6 μετο αρχείο Vs6sp6.exe
Σε περίπτωση που κάποιος βρει τα παραπάνω και έχει χάσει το κλειδί πρέπει να γράψει το εκατόν δέκα στο πρώτο κουτάκι και από το ένα ως το επτά στο δεύτερο.

Για να τρέξουμε την Μ2000 μέσα από το περιβάλλον της VB6 πρέπει να τρέξουμε το πρόγραμμα που φτιάχνει το m2000.dll, το Μ2000vbp, και μετά να τρέξουμε το m2000.exe το οποίο φορτώνει το dll. Το ωραίο εδώ είναι ότι μπορούμε να διορθώνουμε το κώδικα μέσα στο περιβάλλον της VB6 ενώ χρησιμοποιείται ως dll από το m2000.exe. Μπορούμε ακόμα και το m2000.exe αντί να το τρέξουμε απ ευθείας, να ανοίξουμε το mexe.vbp σε δεύτερο περιβάλλον της VB6, οπότε τρέχουμε από εκεί και έτσι μπορούμε ταυτόχρονα να κάνουμε debugging και στα δυο περιβάλλοντα (τα οποία συνδέονται). Ο μόνος περιορισμός που υπάρχει κατά το debugging είναι ότι δεν μπορούμε να καλέσουμε το m2000.dll δυο ή περισσότερες φορές.  Πράγμα που γίνεται όταν έχουμε φτιάξει το m2000.dll, και το καλούμε εκτός περιβάλλοντος vb6. Όταν τρέχει το m2000.exe εκτός του vb6 περιβάλλοντος, έχει αυξημένο μέγεθος σωρού επιστροφής. Το m2000.dll φορτώνεται στο χώρο του m2000.exe και στo ίδιο νήμα, δηλαδή με τον ίδιο αυξημένο σε μέγεθος σωρό επιστροφής.  Αν γράψουμε Έλεγχος ή Monitor στη γραμμή εντολών της  Μ2000 θα μας δείξει τον υπολογιζόμενο αριθμό κλήσεων - αναδρομής των τμημάτων και των συναρτήσεων.

Εικόνα με την επιστροφή της Monitor (φαίνεται μέρος της κονσόλας της Μ2000)


Παρασκευή, 5 Ιουλίου 2019

Καλοκαίρι 2019

Από 1 Ιουλίου μετακόμισα στην Αθήνα, για να είμαι κοντά στα παιδιά μου και την εγγονή μου. Το έργο μου θα συνεχιστεί από τις 15 Ιουλίου.

Τρίτη, 18 Ιουνίου 2019

Revision 28 Version 9.8

A syntax color fix
line:
                  maze$(INT((currentx% oldx%) / 2), ((currenty% oldy%) / 2)) = " "
See at the end, at /2)) the two parenthesis now have the proper different color.

This is the Maze module in info.gsb (included in m2000 installation file)



Module Maze {
      width% = 40
      height% = 20
      \\ we can use DIM maze$(0 to width%,0 to  height%)="#"
      \\ so we can delete the two For loops
      DIM maze$(0 to width%,0 to height%)
      FOR x% = 0 TO width%
          FOR y% = 0 TO height%
              maze$(x%, y%) = "#"
          NEXT y%
      NEXT x%

      currentx% = INT(RND * (width% - 1))
      currenty% = INT(RND * (height% - 1))

      IF currentx% MOD 2 = 0 THEN currentx%++
      IF currenty% MOD 2 = 0 THEN currenty%++
      maze$(currentx%, currenty%) = " "

      done% = 0
      WHILE done% = 0 {
          FOR i% = 0 TO 99
              oldx% = currentx%
              oldy% = currenty%
              SELECT CASE INT(RND * 4)
                  CASE 0
                      IF currentx% + 2 < width% THEN currentx%+=2
                  CASE 1
                      IF currenty% + 2 < height% THEN currenty%+=2
                  CASE 2
                      IF currentx% - 2 > 0 THEN currentx%-=2
                  CASE 3
                      IF currenty% - 2 > 0 THEN currenty%-=2
              END SELECT
              IF maze$(currentx%, currenty%) = "#"  Then {
                  maze$(currentx%, currenty%) = " "
                  maze$(INT((currentx% + oldx%) / 2), ((currenty% + oldy%) / 2)) = " "
             }
          NEXT i%
          done% = 1
          FOR x% = 1 TO width% - 1 STEP 2
              FOR y% = 1 TO height% - 1 STEP 2
                  IF maze$(x%, y%) = "#" THEN done% = 0
              NEXT y%
          NEXT x%
      }


      FOR y% = 0 TO height%
          FOR x% = 0 TO width%
              PRINT maze$(x%, y%);
          NEXT x%
          PRINT
      NEXT y%
}
Maze