The Matrix

General FreeBASIC programming questions.
Post Reply
neil
Posts: 556
Joined: Mar 17, 2022 23:26

The Matrix

Post by neil »

The matrix rain code. I updated the code.

Code: Select all

'' The Matrix Rain Code

Declare Sub delay(ByVal amt As Single, ByVal thr As Ulong = 2)

Sub delay(ByVal amt As Single, ByVal thr As Ulong)
    Dim As Double t1 = Timer
    Dim As Double t2 = t1 + amt / 1000
    If amt > thr + 0.5 Then Sleep amt - thr, 1
    Do
    Loop Until Timer >= t2
End Sub

'' Screen 12,8,1,1 '' 640x480
'' Screen 19,8,1,1 '' 800x600

Screen 20,8,1,1 '' 1024x768

'' Screen 21,8,1,1 '' 1280x1024

setmouse 0,0,0

Dim As short char,a,y,z
Dim As UByte col,row,speed
Dim As String newchar

'' screen 12 settings
'' col = 78
'' row = 29

'' screen 19 settings
'' col = 98
'' row = 36

'' screen 20 settings
col = 126
row = 47

'' screen 21 settings
'' col = 158
'' row = 63

RANDOMIZE

DIM x(1 TO row) AS Ulong
DIM c(1 TO row) As Ulong

FOR a = 1 TO row
c(a) = 1
x(a) = 1
NEXT

Cls
DO
FOR a = 1 TO row
c(a) = x(a)
x(a) = (RND * col) + 1 '' screen columns
  
FOR y = 1 TO row

'' delay
delay 1.6

    z = a - y + 1
    IF z < 1 THEN
    z = z + row
    END IF

''char = (RND * 1) + 48 '' for binary only string

  char = (RND * 94) + 33 '' for ascii string

  newchar = CHR(char)
 
  LOCATE y, x(z)
  COLOR 11
  PRINT newchar
  LOCATE y, c(z)
  PRINT " "
    IF y = 1 THEN
    LOCATE row, c(z)
    ELSE
    LOCATE y - 1, x(z)
    END IF
  COLOR 2
  PRINT newchar
  If inkey = chr(27) Then exit Do
NEXT
NEXT

LOOP
Last edited by neil on Oct 10, 2023 3:15, edited 5 times in total.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: The Matrix

Post by neil »

I added 2 more Screen settings Screen 20 and Screen 21. You need to uncomment the one you want to use. Also you need to uncomment in the Screen settings part of the code.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: The Matrix

Post by neil »

I updated the code for the matrix rain code. It uses the timer to figure out how many loop counts it needs for the delay.
You only need to select a speed between the range (0 to 10). I would not use this timer method on other projects when accuracy is needed.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The Matrix

Post by dodicat »

Swingin' in the rain.

Code: Select all

Dim shared as any ptr RainIm
declare Sub Bmouse(mx As Integer,my As Integer,sz As Integer)
Sub Rain()
    const max=1000
    static as single xx(max),yy(max)
    For i as long = 0 to max
    xx(i) = rnd*1024
    yy(i) = rnd*768
    Put(xx(i),yy(i)),RainIm,alpha,rnd*200
    Next
End Sub
screen 20,32
color ,rgb(0,150,255)
RainIm=ImageCreate(5,20)
Line RainIm,(0,0)-(5,20),rgb(50,50,55)

 #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
 #define inbox (mx>125) and (mx<475)' and (my>300) and (my<350)
 #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
 
 #macro display
    fr=map(125,475,cx,10,65)
    screenlock
    cls
    draw string(20,20),"Actual Framerate     = " &fps
    draw string(20,40),"Requested Framerate  = " &fr
    draw string(100,280),"10"
    draw string(480,280),"65"
    draw string(250,280),"<--slider-->"
    angle+=.1
    drawline(600,200,.2*sin(angle)-pi/2,300,4)
    line(100,300)-(500,350),rgb(0,200,0),bf
    circle(cx,cy),25,rgb(200,0,0),,,,f
    bmouse(cx-5,cy-5,15)
    rain
    screenunlock
   sleep regulate(fr,fps)
#endmacro

#macro mouse
Dim As Long x=mx,y=my,dx,dy
While mb = 1
    Display
    Getmouse mx,my,,mb
    If inbox Then
        If mx<>x Or my<>y  Then
            dx = mx - x
            dy = my - y
            x = mx
            y = my
            cx=x+dx
            if cx<125 then cx=125
            if cx>475 then cx=475
        End If
    End If
Wend
#endmacro

sub drawline(x as long,y as long,angle as single,length as long,col as ulong)
    var x2=x+length*cos(angle)
    var y2=y-length*sin(angle)
     line(x,y)-(x2,y2)
     circle(x2,y2),10,rgb(200,100,0),,,,f
end sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function


dim as long mx,my,mb
dim as long cx=125,cy=325,fps,fr
dim as single angle,pi=4*atn(1)
do
    getmouse mx,my,,mb
    
    display
    
    if incircle(cx,cy,25,mx,my) and mb=1 then
        mouse
        end if
   
    loop until len(inkey)
    imagedestroy RainIm
    
    Sub _line(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,l As Integer,col As Ulong,Byref xp As Integer=0,Byref yp As Integer=0)
    Dim As Integer diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
    If ln=0 Then ln=1e-6
    Dim As Single nx=diffx/ln,ny=diffy/ln 
    xp=x1+l*nx:yp=y1+l*ny
    Line(x1,y1)-(xp,yp),col
End Sub

Sub Bmouse(mx As Integer,my As Integer,sz As Integer)
    Dim As Integer xp,yp
    dim as ulong c=rgb(255,255,250)
    _line(mx,my,mx+sz,my+.8*sz,sz,c,xp,yp)
    _line(xp,yp,mx+sz/2,yp+.03*sz,.4*sz,c,xp,yp)
    Var tx=xp,ty=yp
    _line(mx,my,mx,my+1.2*sz,sz,c,xp,yp)
    _line(xp,yp,mx+sz/2,yp-sz/2,.4*sz,c,xp,yp)
    _line(xp,yp,mx+sz/2,yp+sz/2,sz,c,xp,yp)
    _line(xp,yp,xp+sz/2,yp-.4*sz,.2*sz,c,xp,yp)
    _line(xp,yp,tx,ty,.95*sz,c,xp,yp)
    Paint(mx+.1*sz,my+.2*sz),c,c
End Sub
    
  
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: The Matrix

Post by neil »

@dodicat
I tried using your regulator and it did not seem to run any faster then sleep 1. That's why I used the delay loop.
Is there another way to do get your regulator to run any faster then sleep 1?
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The Matrix

Post by dodicat »

With Windows you can make sleep 1 close to 1 millisecond, it is by default about 15 milliseconds.

Code: Select all


Dim shared as any ptr RainIm
declare Sub Bmouse(mx As Integer,my As Integer,sz As Integer)
declare function settimer       alias "timeBeginPeriod"(as Ulong=1) as long
declare function freetimer      alias "timeEndPeriod"  (as Ulong=1) as long
Sub Rain()
    const max=1000
    static as single xx(max),yy(max)
    For i as long = 0 to max
    xx(i) = rnd*1024
    yy(i) = rnd*768
    Put(xx(i),yy(i)),RainIm,alpha,rnd*200
    Next
End Sub
screen 20,32
color ,rgb(0,150,255)
RainIm=ImageCreate(5,20)
Line RainIm,(0,0)-(5,20),rgb(50,50,55)

 #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
 #define inbox (mx>125) and (mx<475)' and (my>300) and (my<350)
 #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
 
 #macro display
    fr=map(125,475,cx,10,160)
    screenlock
    cls
    draw string(20,20),"Actual Framerate     = " &fps
    draw string(20,40),"Requested Framerate  = " &fr
    draw string(100,280),"10"
    draw string(480,280),"160"
    draw string(250,280),"<--slider-->"
    angle+=.1
    drawline(600,200,.2*sin(angle)-pi/2,300,4)
    line(100,300)-(500,350),rgb(0,200,0),bf
    circle(cx,cy),25,rgb(200,0,0),,,,f
    bmouse(cx-5,cy-5,15)
    rain
    screenunlock
     settimer
   sleep regulate(fr,fps)
    freetimer
#endmacro

#macro mouse
Dim As Long x=mx,y=my,dx,dy
While mb = 1
    Display
    Getmouse mx,my,,mb
    If inbox Then
        If mx<>x Or my<>y  Then
            dx = mx - x
            dy = my - y
            x = mx
            y = my
            cx=x+dx
            if cx<125 then cx=125
            if cx>475 then cx=475
        End If
    End If
Wend
#endmacro

sub drawline(x as long,y as long,angle as single,length as long,col as ulong)
    var x2=x+length*cos(angle)
    var y2=y-length*sin(angle)
     line(x,y)-(x2,y2)
     circle(x2,y2),10,rgb(200,100,0),,,,f
end sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function


dim as long mx,my,mb
dim as long cx=125,cy=325,fps,fr
dim as single angle,pi=4*atn(1)
do
    getmouse mx,my,,mb
    
    display
    
    if incircle(cx,cy,25,mx,my) and mb=1 then
        mouse
        end if
   
    loop until len(inkey)
    imagedestroy RainIm
    
    Sub _line(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,l As Integer,col As Ulong,Byref xp As Integer=0,Byref yp As Integer=0)
    Dim As Integer diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
    If ln=0 Then ln=1e-6
    Dim As Single nx=diffx/ln,ny=diffy/ln 
    xp=x1+l*nx:yp=y1+l*ny
    Line(x1,y1)-(xp,yp),col
End Sub

Sub Bmouse(mx As Integer,my As Integer,sz As Integer)
    Dim As Integer xp,yp
    dim as ulong c=rgb(255,255,250)
    _line(mx,my,mx+sz,my+.8*sz,sz,c,xp,yp)
    _line(xp,yp,mx+sz/2,yp+.03*sz,.4*sz,c,xp,yp)
    Var tx=xp,ty=yp
    _line(mx,my,mx,my+1.2*sz,sz,c,xp,yp)
    _line(xp,yp,mx+sz/2,yp-sz/2,.4*sz,c,xp,yp)
    _line(xp,yp,mx+sz/2,yp+sz/2,sz,c,xp,yp)
    _line(xp,yp,xp+sz/2,yp-.4*sz,.2*sz,c,xp,yp)
    _line(xp,yp,tx,ty,.95*sz,c,xp,yp)
    Paint(mx+.1*sz,my+.2*sz),c,c
End Sub
    
   
Post Reply