Text to Speech with Events

For wine we have to install Sapi5, if not exist. To do this use this in linux terminal: winetricks speechsdk


The difficult part was the number and the wrap in screen. Text is written word by word as object sp (an SAPI.SpVoice) speak words. Scrolling happen normally after last line. Symbols like comma and parenthesis can't displayed (are not words).

New M2000 version need for each parameter of an event handler function, for COM objects, to use & for ByRef or as-is a variable fo ByValue pass. Old versions have to use always by ref (using &). So here we have all passing by value for working with Version 10.

Module UsingEvents {
      Form 60, 32
      Declare WithEvents sp "SAPI.SpVoice"
      That$={Rosetta Code is a programming chrestomathy site.
      The idea is to present solutions to the same task in as many different languages as possible, to demonstrate how languages are similar and different, and to aid a person with a grounding in one approach to a problem in learning another. Rosetta Code currently has 913 tasks, 214 draft tasks, and is aware of 707 languages, though we do not (and cannot) have solutions to every task in every language.}
      EndStream=False
      LastPosition=-1
      TxtWidth=0
      Function sp_Word {
            Read New StreamNumber, StreamPosition, CharacterPosition, Length
            Rem: Print StreamNumber, StreamPosition , CharacterPosition, Length
            If LastPosition=CharacterPosition Then exit
            LastPosition=CharacterPosition
            Local f$=" "
            If TxtWidth=CharacterPosition+length Then f$=". "
            If length+pos+2>width then Print
            Print Mid$(That$, CharacterPosition+1, Length);f$;
            If f$=". " Then Print
            Refresh
      }
      Function sp_EndStream {
            Refresh
            EndStream=True
      }
      Function sp_Sentence {
            Read New StreamNumber, StreamPosition, CharacterPosition, Length
            if Length>0 and not CharacterPosition=0 then Print
            Print "  ";
            TxtWidth=CharacterPosition+Length-1
      }
      Const SVEEndInputStream = 4
      Const SVEWordBoundary = 32
      Const SVESentenceBoundary = 128
      Const SVSFlagsAsync = 1&

      With sp, "EventInterests", SVEWordBoundary+SVEEndInputStream+SVESentenceBoundary
      Method sp, "Speak", That$, SVSFlagsAsync
      While Not EndStream {Wait 10}
      Wait 100
}
UsingEvents

Hunt The Wumpus

This is a simple implementation of the classic textual game Hunt The Wumpus.
First publish at rosettacode.org

Walk from one room to other, in a total of 20 rooms, to find the Wumpus Monster and kill it. Each room has three tunnels to link to other rooms. All rooms are vertexes in a dodecahedron.
There are two Giant bats, which always transport you to a random empty room. Also there are two bottomless pits which kill you; Also you have 5 arrows and if miss to kill the Wumpus then it is 75% a chance which he move to adjacent room. If you miss the last shot then you loose.
You can use H to toggle Help on/off. Help display player and wumpus position, the three tunnels and the number of each room for these, and the contents of rooms too. You can delete any information you desire in Sense() subroutine.

Module WumpusGame {
      Print "Game: Hunt The Wumpus"
      Arrows=5
      Dim Room(1 to 20)
      Room(1)=(2,6,5),(3,8,1),(4,10,2),(5,2,3),(1,14,4)
      Room(6)=(15,1,7),(17,6,8),(7,2,9),(18,8,10),(9,3,11)
      Room(11)=(19,10,12),(11,4,13),(20,12,14),(5,11,13), (6,16,14)
      Room(16)=(20,15,17),(16,7,18),(17,9,19),(18,11,20),(19,13,16)
      Enum Things {EmptyRoom, Bat1, Bat2, Pit1, Pit2, Wumpus}
      Dim Content(1 to 20)=EmptyRoom
      i=each(Things,2) ' from 2 to End
      While i {
            r=random(1,20)
            if Content(r)<>EmptyRoom then restart
            Content(r)=Eval(i)
      }
      WumpusPos=r
      PlayerPos=-1
      TranspotPlayer()
      Done=False
      \\ Help is statement but here used as variable
      Help=False
      While Arrows>0 And Not Done {
            Sense()
            Print "W- Walk, T - Throw Arrow, G - Give up or H for Help"
            a$=Ucase$(Key$)
            If a$="W" Then {
                  Print "Choose Tunnel to Walk: 1, 2 or 3"
                  r=Val("0"+Key$)-1
                  if r>=0 and r<=2 then {
                        PlayerPos=Array(room(PlayerPos), r)
                        Select Case Content(PlayerPos)
                        Case Wumpus
                        Eaten()
                        Case Pit1, Pit2
                        {
                              Arrows=0
                              Print "You fall to a bottomless pit;"
                        }
                        Case Bat1, Bat2
                        {
                              Print "A giant bat takes you in another room;"
                              TranspotPlayer()
                        }
                        End Select
                  }
            } Else.if a$="T" Then {
                  Arrows--
                  Print "Choose Tunnel to Throw Arrow: 1, 2  or 3"      
                  r=Val("0"+Key$)-1
                  if r>=0 and r<=2 then {
                        i=room(PlayerPos)
                        If Content(Array(i, r))=Wumpus then {
                              Done=True
                      } Else.if random(1,4)<4 then WakeWumpus()
                  }            
            } Else.if a$="G" Then {
                   Arrows=0
            } Else.if a$="H" Then Help~
      }
      If Done then Print "You kill the Monster Wumpus; You Win.": Exit
      Print "You loose."
     
      Sub TranspotPlayer()
            local r=random(1,20)
            While Content(r)<>EmptyRoom {r=random(1,20)}
            PlayerPos=r
      End Sub
      Sub WakeWumpus()
            local j=array(room(WumpusPos),random(0,2))
            If content(j)=EmptyRoom Then {
                  swap content(j), content(WumpusPos)
                  WumpusPos=j
                  If WumpusPos=PlayerPos then Eaten()
            }
      End Sub
      Sub Eaten()
            Arrows=0
            Print "You eaten by Wumpus;"
      End Sub
      Sub Sense()
            local k=Room(PlayerPos)
            local j=each(k), Wumpus_near, bat_near, pit_near
            If Help then Print "Player Room:";PlayerPos, "Wumpus Room:";WumpusPos
            While j {
                  If Help Then Print "Tunnel:";j^+1, "Room:";Array(j), "Content:";eval$(content(array(j)))
                  Select Case content(array(j))
                  Case Bat1, Bat2
                  bat_near=True
                  Case Pit1, Pit2
                  pit_near=True
                  Case Wumpus
                  Wumpus_near=True
                  End Select
            }
            If Wumpus_near Then Print "You smell something terrible nearby."
            If bat_near Then Print "You hear a rustling."
            if pit_near Then Print "You feel a cold wind blowing from a nearby cavern."
      End Sub
}
WumpusGame

Mandelbrot Plot

Code for a Mandelbrot Plot. Make a 512X416 image in console beginning with a 32X28 plot with a big pixel as 16x16 pixels and print until 512x416 and 1:1 pixels.

Paste the code in a module, say a: In M2000 console, write Edit A and then paste the code and press Esc to exit. Now write A and press enter.

Module Mandelbrot(x=0&,y=0&,z=1&) {
      If z<1 then z=1
      If z>16 then z=16
      Const iXmax=32*z
      Const iYmax=26*z
      Def single Cx, Cy, CxMin=-2.05, CxMax=0.85, CyMin=-1.2, CyMax=1.2
      Const PixelWidth=(CxMax-CxMin)/iXmax, iXm=(iXmax-1)*PixelWidth
      Const PixelHeight=(CyMax-CyMin)/iYmax,Ph2=PixelHeight/2
      Const Iteration=25
      Const EscRadious=2.5, ER2=EscRadious**2
      Def single preview
      preview=iXmax*twipsX*(z/16)
      Def long yp, xp, dx, dy, dx1, dy1
      Let dx=twipsx*(16/z), dx1=dx-1
      Let dy=twipsy*(16/z), dy1=dy-1
      yp=y
      For iY=0 to (iYmax-1)*PixelHeight step PixelHeight {
            Cy=CyMin+iY
            xp=x
            if abs(Cy)<Ph2 Then Cy=0
            For iX=0 to iXm Step PixelWidth {
                  Let Cx=CxMin+iX,Zx=0,Zy=0,Zx2=Zx**2,Zy2=Zy**2
                  For It=Iteration to 1 {Let Zy=2*Zx*Zy+Cy,Zx=Zx2-Zy2+Cx,Zx2=Zx**2,Zy2=Zy**2 :if Zx2+Zy2>ER2 Then exit
                  }
                  if it>13 then {it-=13} else.if it=0 then SetPixel(xp,yp,0): xp+=dx : continue
                  it*=10:SetPixel(xp,yp,color(it, it,255)) :xp+=dx
            } : yp+=dy
      }
      Sub SetPixel()
            move number, number: fill dx1, dy1, number
      End Sub
}
Cls 1,0
sz=(1,2,4,8,16)
i=each(sz)
While i {
      Mandelbrot 250*twipsx,100*twipsy, array(i)
}

Rational Numbers Class

This is a Rational Numbers class and an example.
Rosetta code - 1st publishing
Using a part of this class to find perfect numbers
Another way to find perfect numbers using primes

Added pz as pointer to rational number. Operators works ok with pointers but return a new rational number not a pointer.
We can get a pointer if we wish:
      zzz->(pk+pk)
      Print zzz=>toString$

Module RationalNumbers {
      Class Rational {
            numerator as decimal, denominator as decimal
            gcd=lambda->0
            lcm=lambda->0
            operator "+" {
                 Read l
                 denom=.lcm(l.denominator, .denominator)
                 .numerator<=denom/l.denominator*l.numerator+denom/.denominator*.numerator
                 if .numerator==0 then denom=1
                 .denominator<=denom
            }
            Operator Unary {
                  .numerator-!
            }
            Operator "-" {
                  Read l
                  Call Operator "+", -l
            }
            Operator "*" {
                  Read l
                  g1=.gcd(l.numerator,.denominator)
                  g2=.gcd(.numerator, l.denominator)
                  Push l.numerator/g1*.numerator/g2
                  Push l.denominator/g2*.denominator/g1
                  Read .denominator, .numerator

            }
            Function Inverse {
                  if .numerator==0 then Error "Division by zero"
                  ret=This
                  sign=sgn(ret.numerator) : if sign<0 then ret.numerator-!
                  swap ret.numerator, ret.denominator
                  if sign<0 then ret.numerator-!
                  =ret
            }
            Operator "/" {
                  Read l
                  call operator "*", l.inverse()
            }
            Function Power {
                  Read pow as long
                  ret=This
                  ret.numerator<=.numerator^pow
                  ret.denominator<=.denominator^pow
                  =ret
            }
            Operator "=" {
                  Read l
                  Def boolean T=True, F=False
                  if Abs(sgn(l.numerator))+Abs(sgn(.numerator))=0 then Push T: exit
                  if sgn(l.numerator) <>sgn(.numerator) then Push F : exit
                  pcomp=l/this
                  PUSH pcomp.numerator=1 and pcomp.denominator=1
            }
            Operator ">" {
                  Read l
                  Def boolean F
                  if Abs(sgn(l.numerator))+Abs(sgn(.numerator))=0 then Push F: exit
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator>0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real>1
                  }
            }
            Operator ">=" {
                  Read l
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator>=0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real>=1
                  }
            }      
            Operator "<" {
                  Read l
                  Def boolean F
                  if Abs(sgn(l.numerator))+Abs(sgn(.numerator))=0 then Push F: exit
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator<0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real<1
                  }
            }
            Operator "<=" {
                  Read l
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator<=0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real<=1
                  }            
            }
            Operator "<>" {
                  Read l
                  if sgn(l.numerator)=0 then {
                        PUSH .numerator<>0
                  } Else {
                        pcomp=this/l
                        PUSH pcomp.real<>1
                  }            
            }
            Group Real {
                  value {
                        link parent numerator, denominator to n, d
                        =n/d
                  }
            }
            Group ToString$ {
                 value {
                        link parent numerator, denominator to n, d
                        =Str$(n)+"/"+Str$(d,"")
                  }      
            }
            class:
            Module Rational (.numerator, .denominator) {
                  if .denominator<=0 then Error "Positive only denominator"
                  gcd1=lambda (a as decimal, b as decimal) -> {
                        if a<b then swap a,b
                        g=a mod b
                        while g {
                              a=b:b=g: g=a mod b
                        }
                              =abs(b)
                  }
                  .gcd<=gcd1
                  .lcm<=lambda gcd=gcd1 (a as decimal, b as decimal) -> {
                        =a/gcd(a,b)*b
                  }
            }
      }
      Print rational(-3,3)<>rational(-3,3)
      M=Rational(10, 150)
      N=Rational(2, 4)
      Z=M+N
      Print Z.numerator, Z.denominator
      Print 10/150@+2/4@
      Print Z.real
      Z=-M+N
      Print Z.numerator, Z.denominator
      Print -10/150@+2/4@
      Print Z.real
      Z=M-N
      Print Z.numerator, Z.denominator
      Print 10/150@-2/4@
      Print Z.real
      Z=M*N
      Print Z.numerator, Z.denominator
      Print (10/150@)*(2/4@)
      Print Z.real
      Z=M/N
      Print Z.numerator, Z.denominator
      Print (10/150@)/(2/4@)
      Print Z.real
      Z=Z.Power(2)
      Print Z.real
      Print Z=Z
      Print Z=N
      Print Z=-Z
      ZZ=-Z
      Print ZZ=ZZ
      Print -Z=-Z
      Print Z.numerator, Z.denominator
      Print Z.real, Z.tostring$
      \\ Array of rational numbers
      Dim K(100)=rational(1,1)
      M=K(4)+K(3)
      Print M.real
      Print K(4).toString$

           pk->(Z)
      Print pk=>toString$
      zzz=pk+pk
      Print zzz.toString$

}
RationalNumbers