Αναθεώρηση 17 Έκδοση 9.5

Διορθώθηκε το AYTO η μεταβλητή που δείχνει το αντικείμενο μέσα σε μια ομάδα. Σε ορισμένες περιπτώσεις δεν λειτουργούσε σωστά (όπως σωστά λειτουργούσε στην έκδοση 9.4). Λόγω βελτίωσης του κώδικα, έγινε λάθος και η ειδική συνάρτηση για αυτό δεν είχε ολοκληρωθεί σωστά με συνέπεια ενώ έβρισκε το αντικείμενο δεν το επέστρεφε, και γύρναγε το AYTO ως έχει. Παρόλα αυτά το σύστημα λειτουργούσε στις περισσότερες άλλες περιπτώσεις γιατί όταν γύριζε το ΑΥΤΟ (και όχι το πραγματικό όνομα της ομάδας) άλλες συναρτήσεις το ανέλυαν ξανά και το έβρισκαν! Υποτίθεται ότι η συγκεκριμένη "προβληματική" συνάρτηση έπρεπε αν το έβρισκε νωρίς. Υπήρχε λοιπόν περίπτωση οι άλλες συναρτήσεις να "αδιαφορίσουν" αν το ΑΥΤΟ ήταν μόνο του, και όψι με το όνομα κάποιου μέλους της ομάδας, για παράδειγμα το ΑΥΤΟ.Χ ή .Χ (επειδή συνήθως βάζουμε το .Χ και όχι το ΑΥΤΟ.Χ το σύστημα βρίσκει άμεσα το .Χ παρά τα λάθη της συγκεκριμένης συνάρτησης.
Το βρήκα το λάθος εξετάζοντας παλαιότερα προγράμματα που ήξερα ότι δεν είχαν πρόβλημα! Για να το διορθώσω όμως μου πήρε λίγο χρόνο για να βρω που στο κώδικα ήταν. Κατέφυγα σε μια λύση...που λέει ότι αν έχεις ένα άλλο παλαιότερο κώδικα που δουλεύει φτιάξε ένα αντίγραφο και άρχισε να αλλάζεις συναρτήσεις (δέκα δέκα ας πούμε) μέχρι να σου δείξει το πρόγραμμα σε ποιες έχει θέμα, μετά το βρίσκεις αμέσως!

Το παράδειγμα που τώρα δουλεύει είναι αυτό:
https://georgekarras.blogspot.com/2018/06/queue-with-pointers.html

Revision 16 Version 9.5

For these changes I have to change Version. So I think in one or two revisions I have to move to 9.6.

1) Overflow in operators *= += /= -= (for decimals)
check the program with upper limit above 27 . Older revision show wrong results for factorial() (first function)

Function factorial (a) {
      def decimal f=1
      Flush
      {
            Loop
            read ? a as decimal
            if a=0 then exit
            f*=a : Push a-1
      }
      =f
}

Function factorial2 (a as decimal) {
  f(1, a)
  sub f(b as decimal , a as decimal)
        if a=0 then =b : exit
        f(a*b, a-1)
  end sub
}

For i=1 to 27
? factorial(i), i
? factorial2(i)
next i


2) New IF Then Else in one linew
Previous versions we have to do this (using a block of code between then and Else
If False then { Print "true"} Else Print "false"

We can use If  true Then  If True Then If  True .... which work for one line.
2.1

The same for Else.If so from this revision we can do the old  and the new
this is the old with blocks (we have to use them if we have multiple lines, or nested if)
if false then {
      print "ok" : print 12,67, 32 : goto 1000
} else.if false then {
             Print "Hello There"
             PRINT "OK1"
}  else.if false then {
      print "not ok2" : ? 12+12
} else 1000 ' a goto 1000
print "done"
1000 print "1000"


Now for on line we can use it without blocks  Do not use nested if without real blocks like the above.

if true then
      print "ok" : print 12,67, 32 : goto 1000
else.if false then
             Print "Hello There" : PRINT "OK1"
else.if false then
      print "not ok2" : ? 12+12
else  1000 ' a goto 1000
print "done"
1000 print "1000"



2.2
using colon to separate statements. We can use goto inside. This is one line (wrapped)
if true then print "ok" : print 12,67, 32 : goto 1000 else.if false then ? "HELLO THERE": PRINT "OK1" else.if false then print "not ok2" : ? 12+12 else ? "not found"
print "done"
1000 print "1000"


2.3
try these
if  false else if false then ? "ok1" else.if false then print "ok2" else if false then ? "done" else ? "ok3"
if  false else if false then ? "ok1" else.if false then print "ok2" else if true then ? "done" else ? "ok3"
if  false else if false then ? "ok1" else.if true then print "ok2" else if true then ? "done" else ? "ok3"
if  false else if true then ? "ok1" else.if true then print "ok2" else if true then ? "done" else ? "ok3"
if  true else if true then ? "ok1" else.if true then print "ok2" else if true then ? "done" else ? "ok3"

if  true then if false then ? "ok1" else.if false then print "ok2" else if false then ? "done" else ? "ok3"
if  true then if false then ? "ok1" else.if false then print "ok2" else if true then ? "done" else ? "ok3"
if  true then if false then ? "ok1" else.if true then print "ok2" else if true then ? "done" else ? "ok3"
if  true then if true then ? "ok1" else.if true then print "ok2" else if true then ? "done" else ? "ok3"
if  true then if true then ? "ok1" else.if true then print "ok2" else if true then ? "done" else ? "ok3"

Dragon Curve

This program written for rosettacode.org.

Use Courier New for Windows OS. Works in linux with Courier. (For the title, see Legend statement)

Use second monitor (if there is no second monitor then open to default).

Update 2022: Esc key now blocked, you can use ctrl+C.

Module Checkit {
      Escape off
      def double angle, d45, d90, change=5000
      const sr2 as double= .70710676237
      Cls 0
      Pen 14
      Desktop Hide
      \\ move console full screen to second monitor  (1 or 2)
      Window 12, 1
      \\ reduce size (tv as second monitor cut pixels from edges)
      Window 12, scale.x*.9, scale.y*.9;
      \\ opacity 100%, but for 0 (black is 100%, and we can hit anything under console window)
      Desktop 255, 0
      \\ M2000 console can divide screen to characters/lines with automatic line space
      Form 60, 30
      \\ cut the border from window
      Form
      \\ scale.x and scale.y in twips
      \\ all graphic/console commands works for printer also (except for Input)
      Move scale.x/2,scale.y/10
      \\ outline graphics, here outline text
      \\ legend text$, font, size, angle, justify(2 for center), quality (non zero for antialiasing, works for angle 0), letter spacing.
      Color {
                  Legend "DRAGON CURVE", "Courier New",SCALE.Y/200,0,2, 1, SCALE.X/50
      }
      angle=0
      d45=pi/4
      d90=pi/2
      Move scale.x/3, scale.y*2/3
      bck=point
      \\ twipsx is width in twips of pixel. twipsy are height in twips of a pixel
      \\ so we use length:twips.x*scale.x/40  or scale.x/40 pixels.
      \\ use % for integer - we can omit these, and we get integer by automatic conversion (overflow raise error)
      dragon(twipsx*scale.x/40,14%, 1)
      a$=key$
      Pen 14
      Cls 5
      \\ set opacity to 100%
      Desktop 255
      Desktop Hide
      Escape On
      End
      \\ Subs are private to this module
      \\ Subs have same scope as module
      Sub turn(rand as double)
            angle+=rand
      End Sub
      \\ angle is absolute, length is relative
      Sub forward(length as double)
            Draw Angle angle, length
      End Sub
      Sub dragon(length as double, split as integer, d as double)
            If split=0 then {
                  forward(length)
            } else {
                  Gosub turn(d*d45)
                  \\ we can omit Gosub
                  dragon(length*sr2,split-1,1)
                  turn(-d*d90)
                  dragon(length*sr2,split-1,-1)
                  turn(d*d45)
                  change--
                  If change else {
                        push 0: do {drop: push random(11,15) : over } until number<>pen: pen number
                        change=5000
                  }
            }
      End Sub
}
Checkit

Revision 15 Version 9.5

From rev 15
1. Many fixes for  bugs from changes from past revisions.
Because of a new faster stack object for group internal struture, two properties are forgotten to implement these functions was broken member$(), member.type$() and Valid(@GroupobjectA as GroupobjectB). So now these fixed.

global group e {
      long alfa=50
      dim k%(10)
}
for i=1 to group.count(e) {
      Print member$(e, i),member.type$(e, i)
}
list

2. Minor works in Forms, especial for modals forms (older versions like 8.2 they work pretty good with this example). We can select XX=0  to open all as non modal.  A modal window disable the user action to form (forms can show anything, and moved also by software). So from this revision also fixed.



\\ An example of modal show
\\ When we open then msgbox we have 5 modal windows,
\\ one after the other, without stopping the background task
\\ Modal Show (with parameter 1), open window disabling others,
\\ but each level of modal window know which window is for enabling again
\\ until we close them
Global XX=1
Declare Simple(5) form
dim Visible(5)
For i=0 to 4
      Method Simple(i), "FontAttr", "Arial Black", 18
      With Simple(i), "Visible" as Visible(i)
      Layer Simple(i) {
            Linespace 30
            Window 12, 10000,8000
            Cls 1,0
            Form 30,20 \\ make 30X20 chars*lines calculating new font size.
            Cursor 0,3
            Print width, height
            Print "01234567890123456789"
      }
Next i
function simple.unload {
      if XX<>0 then exit
      read new index, &cancel
      method Simple(index), "Hide"
      cancel=true
}

k=0
\\ this is the background task
Thread {
      k++
      Print k
      refresh
} As anything

Function simple.click {
      Threads
      Read New index
      Select Case index
      Case 0
      {
            After 50 {
                  Method Simple(1), "Show" , XX
                  Layer { Print "end case 0" }
            }
        }
      Case 1
      {
            After 50 {
                  Method Simple(2), "Show" , XX
                  Layer { Print "end case 1" }
                  }
      }
      Case 2
      {
            After 50 {
                  Method Simple(3), "Show" , XX
                  Layer { Print "end case 2" }
                  }
      }
      Case 3
      {
            After 50 {
                  Method Simple(4), "Show" , XX
                  Layer { Print "end case 3" }
                  }
      }
      Case 4
      {
      after 500 {
                        Print Ask("ok")
                        Layer { Print "end case 4" }
      }
      }
      End Select
      Threads
}
thread {
      Print visible(0), visible(1),visible(2), visible(3), visible(4)
      If visible(0)=0 then thread this erase
      refresh
} as main

After 500 {
      thread anything interval 50
      thread main interval 100
      Method Simple(0), "Show", 1
}
wait 1000
A$=Key$

Print "Finish"
Threads Erase
Declare simple() Nothing
Show  \\ set focus to M2000 console



 3) New Type$(). Rewrite Type$() to handle array and inventory items too. Also we can set a path to inner objects. Some peculiar things with new revision.

group beta {
      x$="1000mm"
      m=100
}
\\  beta copied here
inventory alfa=1:=(list:=1,2,300:=(1,2,3,3,5,beta), 500:="ok")

dim g()
\\  beta copied here
g()=(100,beta,(1, (list:=1:=beta,2,"z":=(1,200,3,alfa), "s":="string"), "Hello there"), 500@, "ok")
g(1).m*=100
Print g(1).m=10000
link g() to g$()
Print type$(g(2), 1)="Inventory"
Print type$(g(2), 1!)="List"   ' show type of inventory (list or queue)
Print type$(g(2), 2)="String", g(2)#val$(2)="Hello there"
Print g$(2)(2)="Hello there"    ' using g$() a reference to g()
Print g$(2)(1)("s")="string"
Print g$(2)(1)("z")(3)(1)(500)="ok"
\\ new this also
Print  g(2)(1)("z")(3)(1)(300)(5).m=100 ' multiple object opening until a group object
\\ new this also. we can get a pointer from inner group
n->g(2)(1)("z")(3)(1)(300)(5)
Print n=>m=100
n=>m++ ' increment one
Print g(2)(1)("z")(3)(1)(300)(5).m=101
Print g(2)(1)("z")(3)(1)(300)(5).x$="1000mm"
n=>x$="2000mm"
Print g(2)(1)("z")(3)(1)(300)(5).x$="2000mm"
m=g() ' we get a pointer to array ' these are not the same as the group's pointers
\\ stacks, inventories and arrays (not those we make with Dim) are pointers
\\ we can use IS operator to check two of them if show same object
z=list:=100, 150:=m, 200
Print z(150)(2)(1)("z")(3)(1)(300)(5).m=101
\\ using g() we pass a copy
\\ but anything which is a pointer (like a list, or a pointer to array) only pointer copied
\\ groups may have or may haven't pointers. Those with no pointers copied when we get an array copy.
\\ Only arrays with names with parenthesis copied. So here we get a copy of g().
z=list:=100, 150:=g(), 200
g(1).m+=100
Print g(1).m=10100
Print z(150)(2)(1)("z")(3)(1)(300)(5).m=101 ' group has a pointer/ also list is the same
Print z(150)(1).m=10000 ' group copied
n=>m++
Print z(150)(2)(1)("z")(3)(1)(300)(5).m=102
Print g(2)(1)("z")(3)(1)(300)(5).m=102






From rev 14

1) Fix for expression evaluator, from last revision (rev.14).

2) Addition for URL encoding/decoding and parsing (introduced in rev. 14 fixed in rev. 15)

Stack New {
      Data "foo://example.com:8042/over/there?name=ferret#nose", "urn:example:animal:ferret:nose"
      Data "jdbc:mysql://test_user:ouupppssss@localhost:3306/sakila?profileSQL=true", "ftp://ftp.is.co.za/rfc/rfc1808.txt"
      Data "http://www.ietf.org/rfc/rfc2396.txt#header1", "ldap://[2001:db8::7]/c=GB?objectClass=one&objectClass=two"
      Data "mailto:John.Doe@example.com", "news:comp.infosystems.www.servers.unix", "tel:+1-816-555-1212"
      Data "telnet://192.0.2.16:80/", "urn:oasis:names:specification:docbook:dtd:xml:4.1.2", "ssh://alice@example.com"
      Data "https://bob:pass@example.com/place", "http://example.com/?a=1&b=2+2&c=3&c=4&d=%65%6e%63%6F%64%65%64"
      a=Array([])
}
function prechar$(a$, b$) {
      if a$<>"" then {=quote$(b$+a$)} else ={""}
}
z=each(a)
document s$="["+{
}
While z {
      a$=array$(z)
      s1$={           "uri": }+quote$(a$)+{,
            "authority": }+ quote$(string$(a$ as URLAuthority))+{,
            "userInfo": }+ quote$(string$(a$ as URLUserInfo))+{,
            "scheme": }+quote$(string$(a$ as URLScheme))+{,
            "hostname": }+quote$(string$(a$ as UrlHost))+{,
            "Port": }+quote$(string$(a$ as UrlPort))+{,
            "pathname": }+quote$(string$(a$ as UrlPath))+{,
            "search": }+prechar$(string$(a$ as URLpart 6),"?")+{,
            "hash": }+prechar$(string$(a$ as UrlFragment),"#")+{
      }
      s$="     {"+{
      }+s1$+"     }"
      if z^<len(a)-1 then s$=" ,"   ' append to document
      s$={
      }
}
s$="]"
Report s$

Ouput:

[
     {
           "uri": "foo://example.com:8042/over/there?name=ferret#nose",
           "authority": "example.com:8042",
           "userInfo": "",
           "scheme": "foo",
           "hostname": "example.com",
           "Port": "8042",
           "pathname": "/over/there",
           "search": "?name=ferret",
           "hash": "#nose"
     } ,
     {
           "uri": "urn:example:animal:ferret:nose",
           "authority": "",
           "userInfo": "",
           "scheme": "urn",
           "hostname": "",
           "Port": "",
           "pathname": "example:animal:ferret:nose",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "jdbc:mysql://test_user:ouupppssss@localhost:3306/sakila?profileSQL=true",
           "authority": "",
           "userInfo": "",
           "scheme": "jdbc",
           "hostname": "",
           "Port": "",
           "pathname": "mysql://test_user:ouupppssss@localhost:3306/sakila",
           "search": "?profileSQL=true",
           "hash": ""
     } ,
     {
           "uri": "ftp://ftp.is.co.za/rfc/rfc1808.txt",
           "authority": "ftp.is.co.za",
           "userInfo": "",
           "scheme": "ftp",
           "hostname": "ftp.is.co.za",
           "Port": "21",
           "pathname": "/rfc/rfc1808.txt",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "http://www.ietf.org/rfc/rfc2396.txt#header1",
           "authority": "www.ietf.org",
           "userInfo": "",
           "scheme": "http",
           "hostname": "www.ietf.org",
           "Port": "80",
           "pathname": "/rfc/rfc2396.txt",
           "search": "",
           "hash": "#header1"
     } ,
     {
           "uri": "ldap://[2001:db8::7]/c=GB?objectClass=one&objectClass=two",
           "authority": "2001:db8::7",
           "userInfo": "",
           "scheme": "ldap",
           "hostname": "2001:db8::7",
           "Port": "389",
           "pathname": "/c=GB",
           "search": "?objectClass=one&objectClass=two",
           "hash": ""
     } ,
     {
           "uri": "mailto:John.Doe@example.com",
           "authority": "",
           "userInfo": "",
           "scheme": "mailto",
           "hostname": "",
           "Port": "",
           "pathname": "John.Doe@example.com",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "news:comp.infosystems.www.servers.unix",
           "authority": "",
           "userInfo": "",
           "scheme": "news",
           "hostname": "",
           "Port": "",
           "pathname": "comp.infosystems.www.servers.unix",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "tel:+1-816-555-1212",
           "authority": "",
           "userInfo": "",
           "scheme": "tel",
           "hostname": "",
           "Port": "",
           "pathname": "+1-816-555-1212",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "telnet://192.0.2.16:80/",
           "authority": "192.0.2.16:80",
           "userInfo": "",
           "scheme": "telnet",
           "hostname": "192.0.2.16",
           "Port": "80",
           "pathname": "",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "urn:oasis:names:specification:docbook:dtd:xml:4.1.2",
           "authority": "",
           "userInfo": "",
           "scheme": "urn",
           "hostname": "",
           "Port": "",
           "pathname": "oasis:names:specification:docbook:dtd:xml:4.1.2",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "ssh://alice@example.com",
           "authority": "alice@example.com",
           "userInfo": "alice",
           "scheme": "ssh",
           "hostname": "example.com",
           "Port": "",
           "pathname": "",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "https://bob:pass@example.com/place",
           "authority": "bob:pass@example.com",
           "userInfo": "bob:pass",
           "scheme": "https",
           "hostname": "example.com",
           "Port": "443",
           "pathname": "/place",
           "search": "",
           "hash": ""
     } ,
     {
           "uri": "http://example.com/?a=1&b=2+2&c=3&c=4&d=%65%6e%63%6F%64%65%64",
           "authority": "example.com",
           "userInfo": "",
           "scheme": "http",
           "hostname": "example.com",
           "Port": "80",
           "pathname": "/",
           "search": "?a=1&b=2+2&c=3&c=4&d=%65%6e%63%6F%64%65%64",
           "hash": ""
     }
]

Revision 13 Version 9.5

Fix a small bug: Test this lin  x=(1,2,3,4,5) : Print x#max()-x#min()

A nice task from rosettacode.org

Module Pairs {
      \\ written in version 9.5 rev. 13
      \\ use Gdi+ antialiasing (not work with Wine in Linux, but we get no error)
      smooth on
      Const center=2, right=3, left=1, blue=1, angle=0, dotline=3
      Const size9pt=9, size11pt=11
      Cls ,0 ' use current background color, set split screen from line 0
      Cursor 0,3
      Report center, "Coordinate pairs"
      x = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
      y = (2.7, 2.8, 31.4, 38.1, 58.0, 76.2, 100.5, 130.0, 149.3, 180.0)
      dx=scale.x/2/len(x)
      dy=dx 'ratio 1:1
      graH=dy*len(x)
      Basex=scale.x/4
      Basey=(scale.y+graH)/2
      Move Basex, Basey
      \\ draw use relative coordinates
      Draw 0,-graH
      \\ Step just move graphic cursor
      Step 0, graH
      Draw scale.x/2
      Step -scale.x/2
      \\ scX is 1, not used
      max=Y#max()
      \\ Auto scale for Y, using 0 for start of axis Y
      scY=-graH/((max+5^log(max) ) div 100)/100
      \\ make vertical axis using dots with numbers center per dx
      j=1
      For i=basex+dx to basex+dx*x#max() Step dx
            Move i, basey
            Step 0, twipsy*10
            Legend format$("{0}",array(x,j)), "courier", size9pt, angle, center
            Width 1, dotline { draw 0, -graH-twipsy*10,7}
            j++
      Next i
      \\ the same for horizontal axis
      HalfTextHeight=Size.y("1","courier", size9pt)/2
      For i=basey-dy to basey-dy*x#max() Step dy
            Move basex, i
            Step -twipsx*10
            Width 1, dotline { draw scale.x/2+twipsx*10,,7}
            Move basex-100, i+HalfTextHeight
            Legend format$("{0}",(i-basey)/scY), "courier", size9pt, angle, left
      Next i
      ex=each(x) : ey=each(y)
     \\ start from first point. We use Draw to for absolute coordinates
      Move array(x,0)*dx+Basex, array(y,0)*scy+Basey
      While ex, ey {
            Width 2 {
                  Draw to array(ex)*dx+Basex, array(ey)*scy+Basey, blue
            }
      }
      \\ second pass for marks and labels
      ex=each(x) : ey=each(y)
      While ex, ey {
            Move array(ex)*dx+Basex, array(ey)*scy+Basey
            Step -75, -75
            Pen 12 {draw 150: draw 0,150 : draw -150 : draw 0,-150}
            Pen 13 {
                  Step 200, -200
                  Legend format$("({0}-{1})",array(ex),array(ey) ), "courier bold", size11pt, angle, right
            }
      }
      \\ screenshot to clipboard
      Screenshot$=""
      Move 0,0
      Copy scale.x, scale.y to Screenshot$
      Clipboard Screenshot$
      a$=key$
}
Pairs