Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Life
#11
Very good!  Fast!
I had to see the R-Pentomino (https://conwaylife.com/wiki/R-pentomino)
So I changed option 5:
Code: (Select All)
If start1 = 5 Then
  mn(200, 100) = 1
  mn(200, 101) = 1
  mn(201, 102) = 1
  mn(202, 102) = 1
  mn(203, 102) = 1
End If
___________________________________________________________________________________
I am mostly grateful for the people who came before me.  Will the people after me be grateful for me?
Reply
#12
(08-14-2022, 02:33 AM)dcromley Wrote: Very good!  Fast!
I had to see the R-Pentomino (https://conwaylife.com/wiki/R-pentomino)
So I changed option 5:
Code: (Select All)
If start1 = 5 Then
  mn(200, 100) = 1
  mn(200, 101) = 1
  mn(201, 102) = 1
  mn(202, 102) = 1
  mn(203, 102) = 1
End If



Thank you...I've started to add some of these patterns
Reply
#13
Using the suggestions from the replies, here is the latest version:

3 patterns from the Life wiki have been added

And...I added a line drawing option, but due to my low skill level it's kind of a problem.   I tried using 'right click' to exit but I don't fully understand how to apply or capture a right mouse click to get out of a loop.   So i changed it to use the ENTER key.   Anyway I'd like to know how to just use the mouse and right click, if anyone can suggest a solution.   Cheers.

Code: (Select All)
' Game of Life based on the 1970 game by John Conway, James2464 Aug 2022

Screen _NewImage(1700, 1000, 32)
_ScreenMove (_DesktopWidth - _Width) \ 2, 20
Randomize Timer

$Resize:Off

Const xblack = _RGB32(0, 0, 0)
Const xwhite = _RGB32(255, 255, 255)
Const xred = _RGB32(255, 0, 0)
Const xgreen = _RGB32(125, 255, 125)
Const xblue = _RGB32(0, 0, 255)
Const xyellow = _RGB32(150, 125, 0)
Const xpink = _RGB32(255, 0, 255)
Const xcyan = _RGB32(0, 255, 255)
Const xbrown = _RGB32(80, 0, 0)
Const xdarkgreen = _RGB32(0, 128, 0)
Const xlightgray = _RGB32(110, 110, 110)
Const xdarkgray = _RGB32(10, 10, 10)

Dim c1~&(100)
c1~&(0) = xblack
c1~&(1) = xwhite
c1~&(2) = xred
c1~&(3) = xgreen
c1~&(4) = xblue
c1~&(5) = xyellow
c1~&(6) = xpink
c1~&(7) = xcyan
c1~&(8) = xbrown
c1~&(9) = xdarkgreen
c1~&(10) = xlightgray
c1~&(11) = xdarkgray

'================================================================================================================
'================================================================================================================
'================================================================================================================

'load data patterns

Dim methuselah52513M(16, 16)
For k = 1 To 16
    For j = 1 To 16
        Read methuselah52513M(j, k)
    Next j
Next k

Dim gosper(36, 9)
For k = 1 To 9
    For j = 1 To 36
        Read gosper(j, k)
    Next j
Next k




'INITIALIZE

Cls
Dim mn(1000, 800)
Dim dp(1000, 800)
Dim aj(1000, 800)

'grid size
gx = 350
gy = 200
'resolution (1=smallest)
res1 = 4

Cls
xtxt = 20

Locate 10, xtxt
Print "Select starting pattern"
Locate 11, xtxt
Print "1.  Full screen random scatter"
Locate 12, xtxt
Print "2.  Free draw with mouse"
Locate 13, xtxt
Print "3.  Line draw with mouse"
Locate 14, xtxt
Print "4.  Methuselah 52513M"
Locate 15, xtxt
Print "5.  R-Pentomino"
Locate 16, xtxt
Print "6.  Gosper Glider Gun"

Locate 20, xtxt
Input "Choose 1-6: ", start1

'=================== random scatter full
If start1 = 1 Then
    For j = 1 To gx
        For k = 1 To gy
            r = Int(Rnd * 10)
            If r < 3 Then
                mn(j, k) = 1
            Else
                mn(j, k) = 0
            End If
        Next k
    Next j
End If

'=============================== free draw with mouse
If start1 = 2 Then
    'use mouse to draw starting pattern

    'draw STARTING GRID
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j
    Do

        Do While _MouseInput
        Loop
        x% = _MouseX
        y% = _MouseY
        'Locate 1, 1
        'Print x%, y%
        x1 = Int(x% / res1)
        y1 = Int(y% / res1)
        mn(x1, y1) = 1
        'mn(x1 - 1, y1 - 1) = 1
        'mn(x1 + 1, y1 - 1) = 1
        'mn(x1 + 1, y1 + 1) = 1
        'mn(x1, y1 + 1) = 1
        'mn(x1 + 1, y1) = 1
        'mn(x1, y1 - 1) = 1
        'draw  GRID
        For j = 1 To gx
            For k = 1 To gy
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Next k
        Next j

        lc% = _MouseButton(1)
    Loop Until lc% = -1
End If

'=============================== random partial
If start1 = 3 Then

    'use mouse to draw lines
    'left click once to start line
    'left click again to finish line
    'right click when finished

    Cls
    Locate 10, 20
    Print "CREATE HORIZONTAL AND VERTICAL LINES"
    Locate 11, 20
    Print "Instructions:  left click in two places"
    Locate 12, 20
    Print "then the line will appear."
    Locate 14, 20
    Print "press ENTER when finished"
    Locate 15, 20
    Print "then left click TWICE to proceed"
    Locate 20, 20
    Print "press any key to begin"
    Sleep

    'draw STARTING GRID
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    Do
        Do


            Do While lc% = -1
                Do While _MouseInput
                Loop
                lc% = _MouseButton(1)
            Loop


            Do While _MouseInput
            Loop
            x% = _MouseX
            y% = _MouseY
            x1 = Int(x% / res1)
            y1 = Int(y% / res1)
            'Locate 3, 1
            'Print x1, y1
            lc% = _MouseButton(1)
        Loop Until lc% = -1

        'register first point that was clicked
        mn(x1, y1) = 1

        Do While lc% = -1
            Do While _MouseInput
            Loop
            lc% = _MouseButton(1)
        Loop





        Do
            'get second point location

            Do While _MouseInput
            Loop
            x% = _MouseX
            y% = _MouseY
            x2 = Int(x% / res1)
            y2 = Int(y% / res1)
            'Locate 5, 1
            'Print x1; y1; ">"; x2; y2
            lc% = _MouseButton(1)
        Loop Until lc% = -1

        Do While lc% = -1
            Do While _MouseInput
            Loop
            lc% = _MouseButton(1)
        Loop





        'determine if line is horizontal or vertical
        If x2 >= x1 Then xd1 = x2 - x1
        If x2 < x1 Then xd1 = x1 - x2
        If y2 >= y1 Then yd1 = y2 - y1
        If y2 < y1 Then yd1 = y1 - y2

        'create horizontal line
        If xd1 >= yd1 Then
            If x1 < x2 Then
                For j = x1 To x2
                    mn(j, y1) = 1
                Next j
            Else
                For j = x2 To x1
                    mn(j, y1) = 1
                Next j
            End If

        End If



        'create vertical line
        If xd1 < yd1 Then
            If y1 < y2 Then
                For k = y1 To y2
                    mn(x1, k) = 1
                Next k
            Else
                For k = y2 To y1
                    mn(x1, k) = 1
                Next k

            End If

        End If



        'draw  GRID
        For j = 1 To gx
            For k = 1 To gy
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Next k
        Next j



        Do While _MouseInput
        Loop
        fl = 0
        If InKey$ = Chr$(13) Then fl = 1
    Loop Until fl = 1


End If

'================================ Methuselah 52513M
If start1 = 4 Then

    'set location
    xp1 = 200
    yp1 = 120

    'draw initial array
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    'update with pattern array at set location xp1,yp1

    For k = 1 To 16
        For j = 1 To 16
            mn(xp1 + j, yp1 + k) = methuselah52513M(j, k)
        Next j
    Next k

End If

'=============================== R-Pentomino
If start1 = 5 Then
    mn(200, 100) = 1
    mn(200, 101) = 1
    mn(201, 102) = 1
    mn(202, 102) = 1
    mn(203, 102) = 1
End If


'================================ Gosper glider gun
If start1 = 6 Then

    'set location
    xp1 = 50
    yp1 = 50

    'draw initial array
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    'update with pattern array at set location xp1,yp1

    For k = 1 To 9
        For j = 1 To 36
            mn(xp1 + j, yp1 + k) = gosper(j, k)
        Next j
    Next k


End If





'================================================================================================================
'================================================================================================================
'================================================================================================================

Cls
Locate 10, xtxt
Print "Press space bar to show starting pattern."
Locate 15, xtxt
Print "Then press space bar again to start algorithm."
Locate 16, xtxt
Print "While running, press 't' to toggle to thermal cam view."

Do: _Limit 10
Loop Until Len(InKey$)

'draw STARTING GRID
For j = 1 To gx
    For k = 1 To gy
        Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
    Next k
Next j

Do: _Limit 10
Loop Until Len(InKey$)

'================================================================================================================
'================================================================================================================
'================================================================================================================

Dim As _MEM m0, m1
m0 = _Mem(dp(0, 0))
m1 = _Mem(mn(0, 0))

Do

    'COPY ARRAY

    'For j = 1 To gx
    '    For k = 1 To gy
    '    dp(j, k) = mn(j, k)
    'Next k
    'Next j

    _MemCopy m1, m1.OFFSET, m1.SIZE To m0, m0.OFFSET

    '================ SCAN FIRST ROW =============================

    'top left corner
    aj(1, 1) = dp(1, 2) + dp(2, 1) + dp(2, 2)

    'main portion of top row
    For j = 2 To gx - 1
        aj(j, 1) = dp(j - 1, 1) + dp(j + 1, 1) + dp(j - 1, 2) + dp(j, 2) + dp(j + 1, 2)
    Next j

    'top right corner
    aj(gx, 1) = dp(gx - 1, 1) + dp(gx - 1, 2) + dp(gx, 2)

    '=============SCAN SECOND TO SECOND LAST ROW=================

    For k = 2 To gy - 1

        'scan first position only
        aj(1, k) = dp(1, k - 1) + dp(2, k - 1) + dp(2, k) + dp(2, k + 1) + dp(1, k + 1)

        'scan main portion of current row
        For j = 2 To gx - 1
            aj(j, k) = dp(j - 1, k - 1) + dp(j, k - 1) + dp(j + 1, k - 1) + dp(j - 1, k) + dp(j + 1, k) + dp(j - 1, k + 1) + dp(j, k + 1) + dp(j + 1, k + 1)
        Next j

        'scan end position only
        aj(gx, k) = dp(gx, k - 1) + dp(gx - 1, k - 1) + dp(gx - 1, k) + dp(gx - 1, k + 1) + dp(gx, k + 1)

    Next k

    '======================SCAN LAST ROW=======================

    'bottom left corner
    aj(1, gy) = dp(1, gy - 1) + dp(2, gy - 1) + dp(2, gy)

    'main portion of last row
    For j = 2 To gx - 1
        aj(j, gy) = dp(j - 1, gy) + dp(j + 1, gy) + dp(j - 1, gy - 1) + dp(j, gy - 1) + dp(j + 1, gy - 1)
    Next j

    'bottom right corner
    aj(gx, gy) = dp(gx - 1, gy) + dp(gx - 1, gy - 1) + dp(gx, gy - 1)

    '=======================APPLY RULES AND UPDATE GRID========================

    'rule 1 - if cell was dead and had exactly 3 neighbours, it becomes alive
    'rule 2 - if cell was alive and had <2 or >3 neighbours, it becomes dead

    For k = 1 To gy
        For j = 1 To gx
            If dp(j, k) = 0 Then
                If aj(j, k) = 3 Then
                    mn(j, k) = 1
                End If
            End If
            If dp(j, k) = 1 Then
                If aj(j, k) < 2 Or aj(j, k) > 3 Then
                    mn(j, k) = 0
                End If
            End If
        Next j
    Next k

    '=======================DRAW NEW UPDATED GRID=============================
    For j = 1 To gx
        For k = 1 To gy
            If tog1 = 0 Then
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Else
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(aj(j, k)), BF
            End If
        Next k
    Next j

    _Display
    i$ = InKey$
    If i$ = "t" Then tog1 = tog1 Xor 1

Loop Until i$ = "x"

End


'=========================================== Known patterns from LifeWiki (Conwaylife.com)


'Methuselah 52513M
Data 1,1,1,0,0,1,1,0,1,0,1,1,0,1,1,1
Data 1,1,0,1,0,1,1,1,0,0,0,0,1,0,1,0
Data 0,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1
Data 0,0,1,0,0,1,1,0,0,0,1,0,0,1,0,0
Data 0,0,1,0,0,0,0,0,1,0,1,0,0,0,1,1
Data 1,0,0,0,0,1,1,0,0,0,1,1,1,0,1,0
Data 0,0,0,1,1,0,0,1,0,0,1,0,1,0,0,1
Data 0,0,1,1,1,1,0,1,0,0,1,0,1,1,0,0
Data 1,1,0,1,1,0,0,1,1,0,0,0,0,0,1,1
Data 1,0,1,1,1,1,0,1,0,0,0,0,1,1,1,0
Data 1,0,0,0,1,1,1,1,0,0,1,1,1,0,0,0
Data 0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1
Data 1,1,0,0,0,1,0,1,1,1,0,1,0,1,1,1
Data 0,1,1,0,1,1,1,1,1,1,0,0,0,1,0,1
Data 1,0,1,0,0,0,0,0,1,1,1,1,0,1,0,0
Data 1,1,1,0,1,0,1,0,1,1,0,0,0,0,0,1


'Gosper glider gun
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1
Data 1,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,1,1,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Reply
#14
I kept making changes for speed...and changed the thermal colors.

Code: (Select All)
_Title "Game of Life as told by Chicken Little"

DefLng A-Z '                 faster than spaghetti

gx = 200 '                   grid size
gy = 150
res1 = 4 '                   resolution (1=smallest)
sx = res1 - 1 '              step x
sy = res1 - 1 '              step y

Dim As _Unsigned Long c1(100)
Dim As _Byte mn(gx, gy), dp(gx, gy), aj(gx, gy), tc(gx, gy)
Dim As _MEM mdp, mmn, maj, mtc

mdp = _Mem(dp(0, 0))
mmn = _Mem(mn(0, 0))
maj = _Mem(aj(0, 0))
mtc = _Mem(tc(0, 0))

Screen _NewImage(gx * res1, gy * res1, 32)
_ScreenMove (_DesktopWidth - _Width) \ 2, 20
Randomize Timer
$Resize:Off
$Checking:Off

begin:

For i = 0 To 11
    j = i * 22: k = 255 - j
    If tog1 Or (i = 0) Then c1(i) = _RGB32(j, 0, 0) Else c1(i) = _RGB32(k, k, k)
Next i

For j = 1 To gx
    For k = 1 To gy
        mn(j, k) = -(Rnd > .5)
    Next k
Next j

t$ = "Spacebar:restart       (t)oggle thermal      e(x)it" '               what to print
Cls
_PrintString (_Width \ 2 - Len(t$) * 4, _Height - 22), t$ '                print centered

Do: _Limit 100

    _MemCopy mmn, mmn.OFFSET, mmn.SIZE To mdp, mdp.OFFSET

    aj(1, 1) = dp(1, 2) + dp(2, 1) + dp(2, 2)

    For j = 2 To gx - 1
        aj(j, 1) = dp(j - 1, 1) + dp(j + 1, 1) + dp(j - 1, 2) + dp(j, 2) + dp(j + 1, 2)
    Next j

    aj(gx, 1) = dp(gx - 1, 1) + dp(gx - 1, 2) + dp(gx, 2)

    For k = 2 To gy - 1

        aj(1, k) = dp(1, k - 1) + dp(2, k - 1) + dp(2, k) + dp(2, k + 1) + dp(1, k + 1)

        For j = 2 To gx - 1
            aj(j, k) = dp(j - 1, k - 1) + dp(j, k - 1) + dp(j + 1, k - 1) + dp(j - 1, k) + dp(j + 1, k) + dp(j - 1, k + 1) + dp(j, k + 1) + dp(j + 1, k + 1)
        Next j

        aj(gx, k) = dp(gx, k - 1) + dp(gx - 1, k - 1) + dp(gx - 1, k) + dp(gx - 1, k + 1) + dp(gx, k + 1)

    Next k

    aj(1, gy) = dp(1, gy - 1) + dp(2, gy - 1) + dp(2, gy)

    For j = 2 To gx - 1
        aj(j, gy) = dp(j - 1, gy) + dp(j + 1, gy) + dp(j - 1, gy - 1) + dp(j, gy - 1) + dp(j + 1, gy - 1)
    Next j

    aj(gx, gy) = dp(gx - 1, gy) + dp(gx - 1, gy - 1) + dp(gx, gy - 1)

    For k = 1 To gy
        For j = 1 To gx
            If dp(j, k) = 0 Then
                If aj(j, k) = 3 Then
                    mn(j, k) = 1
                End If
            End If
            If dp(j, k) = 1 Then
                If aj(j, k) < 2 Or aj(j, k) > 3 Then
                    mn(j, k) = 0
                End If
            End If
        Next j
    Next k

    If tog1 = 0 Then
        _MemCopy mmn, mmn.OFFSET, mmn.SIZE To mtc, mtc.OFFSET
    Else
        _MemCopy maj, maj.OFFSET, maj.SIZE To mtc, mtc.OFFSET
    End If

    For j = 1 To gx
        x = j * res1
        For k = 1 To gy - 10
            y = k * res1
            Line (x, y)-Step(sx, sy), c1(tc(j, k)), BF
        Next k
    Next j

    i$ = InKey$
    If i$ = " " Then restarting = 1: GoTo begin
    If i$ = "t" Then tog1 = tog1 Xor 1: GoTo begin
    If i$ = "x" Then System

    _Display
Loop
Reply
#15
(08-14-2022, 07:27 PM)james2464 Wrote: Using the suggestions from the replies, here is the latest version:

3 patterns from the Life wiki have been added

And...I added a line drawing option, but due to my low skill level it's kind of a problem.   I tried using 'right click' to exit but I don't fully understand how to apply or capture a right mouse click to get out of a loop.   So i changed it to use the ENTER key.   Anyway I'd like to know how to just use the mouse and right click, if anyone can suggest a solution.   Cheers.


Here is a quick demo for right mouse click:
Code: (Select All)
Do
    Cls
    While _MouseInput: Wend ' poll mouse get all updated except wheel from tiny loop
    If _MouseButton(2) Then ' right clicked may want _delay or wait for mouse button release
        Exit Do
    Else
        Cls
        Print "Screen 0 mouse at:"; _MouseX; ","; _MouseY
    End If
    _Limit 60 ' keeps CPU cool
    _Display ' stops flicher from cls
Loop
Print "Good bye!"

_MouseButton(2) just tells us that the Right mouse button is down when the poll took place.

PS Mouse coordinates in Screen 0 are in Char Cells same as use for Locate and Print. In graphics screen mouse coordinates are in pixels.
b = b + ...
Reply
#16
Thank you.

It seems tricky to be able to 'capture' a right-click.    Is there any way to register a 1 or 0 into a variable if a right-click took place?

Also, what sort of delay/wait method would be appropriate? 

If you have a giant loop (lots of things happen)  and the only opportunity to escape this loop is at the very end...if the right-click happened prior to polling...is there any way to know this?  The specific idea here is to allow the user to draw as many lines as they want, and when finished...just 'right-click'.    

I get the impression that using right-click for this purpose is probably just not ideal.   I had it working yesterday...it picked up the right-click but only if both mouse buttons were pressed.   I just ended up admitting defeat.

(Interesting about screen 0 using the character placements for mouse pointer as well.   Good to know)
Reply
#17
"Thank you.

It seems tricky to be able to 'capture' a right-click.    Is there any way to register a 1 or 0 into a variable if a right-click took place?"

Ans: if a right click occurs before the mouse poll, it will register immediately. 
You say:
RightMouseDown = _Mousebutton(2) 
and use the variable later (before end of loop).

"Also, what sort of delay/wait method would be appropriate?"
Ans: I use _Delay .2 should give user plenty of time to release the mouse. The danger is to execute some code more than once if user still has mouse down on next loop around. You can also try OldMoses method of waiting for release of button in a Sub and Steve has a thing that employs an OldmouseButton varaible.

"If you have a giant loop (lots of things happen)  and the only opportunity to escape this loop is at the very end...if the right-click happened prior to polling...is there any way to know this?  The specific idea here is to allow the user to draw as many lines as they want, and when finished...just 'right-click'. 
Ans: I would check RightMouseDown before continue drawing or you can say
While LeftMouseDown
' and keep polling mouse and checking LeftMouse status, exit when released and drag/draw done or _Mousebutton(2) detected.
Wend  

"I get the impression that using right-click for this purpose is probably just not ideal.   I had it working yesterday...it picked up the right-click but only if both mouse buttons were pressed.   I just ended up admitting defeat."
Ans: I think you are right track! Ken uses it in open Intro screen, good practice.
Coming to forum when stuck is not exactly caving in to defeat. 

(Interesting about screen 0 using the character placements for mouse pointer as well.   Good to know)
It is!

BTW I didn't try you samples right away, not until ChiaPet's first version. I liked very much first and fith and thought you were close to replicating glider gun creations. The start of using Life for computing ie a Turing Machine. I started with lines but squares or grids might be very interesting, there is probably a perfect spacing for a grid.
b = b + ...
Reply
#18
I've put together several mouse and keyboard routines for SCREEN 0 over the years.

Here is one demo example...

Code: (Select All)
mydemo% = -1
DIM UI AS UserInput

TYPE UserInput
    KeyPress AS STRING
    KeyCombos AS INTEGER
    MbStatus AS INTEGER
    MbEnvoked AS INTEGER
    drag AS INTEGER
    DoubleClick AS INTEGER
    MbLeftx AS INTEGER
    MbLefty AS INTEGER
    mx AS INTEGER
    oldmx AS INTEGER
    my AS INTEGER
    oldmy AS INTEGER
END TYPE

PRINT "Press keys or use mouse for demo.";
DO
    CALL keyboard_mouse(UI, mydemo%)
    IF UI.MbStatus < 0 AND UI.MbEnvoked = 0 THEN
        SOUND 1000, .3: UI.MbEnvoked = -1
    END IF
    IF UI.KeyPress = CHR$(13) THEN BEEP: EXIT DO
LOOP

DO
    CALL keyboard_mouse(UI, mydemo%)
    IF UI.MbStatus > 0 AND UI.MbEnvoked = 0 THEN
        SOUND 300, .3: UI.MbEnvoked = 1
    END IF
LOOP

END

SUB keyboard_mouse (UI AS UserInput, mydemo%)
    STATIC z1, lclick

    _LIMIT 30

    DEF SEG = 0
    IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN
        UI.KeyCombos = 1 ' Shift = -1 ELSE Shift = 0
    ELSEIF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN
        UI.KeyCombos = 2 ' Ctrl = -1 ELSE Ctrl = 0
    ELSEIF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN
        UI.KeyCombos = 3 ' Ctrl+Shift = -1 ELSE Ctrl+Shift = 0
    ELSEIF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
        UI.KeyCombos = 4 ' Alt = -1 ELSE Alt = 0
    ELSEIF PEEK(1047) MOD 16 = 9 OR PEEK(1047) MOD 16 = 10 THEN
        UI.KeyCombos = 5 ' Shift+Alt = -1 ELSE Shift+Alt = -1
    ELSEIF PEEK(1047) MOD 16 = 12 THEN
        UI.KeyCombos = 6 ' Ctrl+Alt = -1 ELSE Ctrl+Alt = 0
    ELSE
        UI.KeyCombos = 0
    END IF
    DEF SEG

    IF mydemo% THEN GOSUB check_UI.KeyCombos

    UI.KeyPress = INKEY$
    IF LEN(UI.KeyPress) THEN ' A key was pressed.
        UI.MbEnvoked = 0: UI.MbLeftx = 0
        SELECT CASE LEN(UI.KeyPress)
            CASE 1 ' 1-byte key A-Z, etc.
                IF mydemo% THEN mydemo% = 1: GOSUB mydemo
                SELECT CASE UI.KeyPress
                    ' Place key selection routine here...
                    CASE CHR$(27): SYSTEM
                END SELECT
            CASE 2 '2-byte key F1-F12, etc.
                IF mydemo% THEN mydemo% = 2: GOSUB mydemo
                SELECT CASE RIGHT$(UI.KeyPress, 1)
                    ' Place key selection routine here...
                END SELECT
        END SELECT
    ELSE ' Check for mouse input since no keyboard input was detected.

        IF lclick THEN ' Check timer for double-clicks.
            IF TIMER < z1 THEN z1 = z1 - 86400 ' Midnight adjustment.
            IF TIMER - z1 > .33 THEN lclick = 0 ' Too much time ellapsed for a double click.
        END IF

        WHILE _MOUSEINPUT
            mw = mw + _MOUSEWHEEL ' Check for mouse wheel use.
        WEND

        ' Get mouse status.
        UI.mx = _MOUSEX
        UI.my = _MOUSEY
        lb = _MOUSEBUTTON(1)
        rb = _MOUSEBUTTON(2)
        mb = _MOUSEBUTTON(3)

        SELECT CASE UI.MbEnvoked
            CASE 0
                IF lb OR rb OR mb THEN

                END IF
            CASE 1
                IF lb OR rb OR mb THEN UI.MbEnvoked = 0
            CASE -1
                IF lb = 0 AND rb = 0 AND mb = 0 THEN UI.MbEnvoked = 0
        END SELECT

        ' Check for mouse movement.
        IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN
            oldcsrlin = CSRLIN: oldpos = POS(0)
            LOCATE 3, 1: PRINT "Mouse row/col ="; UI.my; UI.mx; "     ";: LOCATE oldcsrlin, oldpos
        END IF

        IF UI.MbStatus < 0 THEN ' Mouse button pressed. UI.MbStatus identity is by number. -1=left, -2=right, -3=middle.
            SELECT CASE UI.MbStatus
                CASE -1 ' Left button was pressed.
                    IF lb = 0 THEN ' Left button released.
                        SELECT CASE lclick ' Single or double click analysis.
                            CASE 0
                                IF mydemo% THEN mydemo% = 3: GOSUB mydemo
                                lclick = lclick + 1
                            CASE ELSE ' Double click. Completed upon 2nd left button release.
                                IF mydemo% THEN mydemo% = 11: GOSUB mydemo
                                UI.DoubleClick = -1
                                lclick = 0
                        END SELECT
                        UI.MbStatus = 1

                        IF UI.MbLeftx THEN
                            IF UI.mx <> UI.MbLeftx OR UI.my <> UI.MbLefty THEN UI.MbStatus = 0: lclick = 0
                            UI.MbLeftx = 0: UI.MbLefty = 0
                        END IF

                        IF UI.drag THEN UI.drag = 0
                    ELSE ' Left button is being held down. Check for UI.drag.
                        IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN ' Mouse cursor has moved. UI.drag.
                            IF mydemo% THEN mydemo% = 12: GOSUB mydemo
                            UI.drag = -1
                        END IF
                    END IF
                CASE -2 ' Right button was pressed.
                    IF rb = 0 THEN ' Right button was relased.
                        IF mydemo% THEN mydemo% = 4: GOSUB mydemo
                        UI.MbStatus = 2
                    END IF
                CASE -3 ' Middle button was pressed
                    IF mb = 0 THEN ' Middle button was released.
                        IF mydemo% THEN mydemo% = 5: GOSUB mydemo
                        UI.MbStatus = 3
                    END IF
            END SELECT
        ELSE
            IF lb THEN ' Left button just pressed.
                IF mydemo% THEN mydemo% = 6: GOSUB mydemo
                UI.MbStatus = -1
                IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
                z1 = TIMER
            ELSEIF rb THEN ' Right button just pressed.
                IF mydemo% THEN mydemo% = 7: GOSUB mydemo
                IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
                UI.MbStatus = -2
            ELSEIF mb THEN ' Middle button just pressed.
                IF mydemo% THEN mydemo% = 8: GOSUB mydemo
                IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
                UI.MbStatus = -3
            ELSEIF mw THEN ' Mouse wheel just moved.
                SELECT CASE mw
                    CASE IS > 0 ' Scroll down.
                        IF mydemo% THEN mydemo% = 9: GOSUB mydemo
                    CASE IS < 0 ' Scroll up.
                        IF mydemo% THEN mydemo% = 10: GOSUB mydemo
                END SELECT
            END IF
        END IF

        UI.oldmx = UI.mx: UI.oldmy = UI.my: mw = 0 ' Mouse position past and present.
    END IF
    EXIT SUB

    mydemo:
    LOCATE 1, 1: PRINT "Last User Status:                                    ";
    LOCATE , 19
    SELECT CASE mydemo%
        CASE 1
            PRINT "1-byte Key = "; UI.KeyPress
        CASE 2
            PRINT "2-byte Key = "; UI.KeyPress
        CASE 3
            PRINT "Left button released."
        CASE 4
            PRINT "Right button released."
        CASE 5
            PRINT "Middle button released."
        CASE 6
            PRINT "Left button down."
        CASE 7
            PRINT "Right button down."
        CASE 8
            PRINT "Middle button down."
        CASE 9
            PRINT "Wheel scroll down."
        CASE 10
            PRINT "Wheel scroll up."
        CASE 11
            PRINT "Left button double click."
        CASE 12
            PRINT "Drag..."
    END SELECT
    mydemo% = -1
    RETURN

    check_UI.KeyCombos:
    IF UI.KeyCombos THEN
        LOCATE 1, 50
        SELECT CASE UI.KeyCombos
            CASE 1
                PRINT "Shift key down.        ";
            CASE 2
                PRINT "Ctrl key down.         ";
            CASE 3
                PRINT "Ctrl + Shift keys down. ";
            CASE 4
                PRINT "Alt key down.          ";
            CASE 5
                PRINT "Alt + Shift keys down.  ";
            CASE 6
                PRINT "Ctrl + Alt keys down."
        END SELECT
    ELSE
        LOCATE 1, 50: PRINT SPACE$(29);
    END IF
    RETURN
END SUB


Pete
Reply
#19
(08-15-2022, 01:42 AM)bplus Wrote: "Thank you.

It seems tricky to be able to 'capture' a right-click.    Is there any way to register a 1 or 0 into a variable if a right-click took place?"

Ans: if a right click occurs before the mouse poll, it will register immediately. 
You say:
RightMouseDown = _Mousebutton(2) 
and use the variable later (before end of loop).

"Also, what sort of delay/wait method would be appropriate?"
Ans: I use _Delay .2 should give user plenty of time to release the mouse. The danger is to execute some code more than once if user still has mouse down on next loop around. You can also try OldMoses method of waiting for release of button in a Sub and Steve has a thing that employs an OldmouseButton varaible.

"If you have a giant loop (lots of things happen)  and the only opportunity to escape this loop is at the very end...if the right-click happened prior to polling...is there any way to know this?  The specific idea here is to allow the user to draw as many lines as they want, and when finished...just 'right-click'. 
Ans: I would check RightMouseDown before continue drawing or you can say
While LeftMouseDown
' and keep polling mouse and checking LeftMouse status, exit when released and drag/draw done or _Mousebutton(2) detected.
Wend  

"I get the impression that using right-click for this purpose is probably just not ideal.   I had it working yesterday...it picked up the right-click but only if both mouse buttons were pressed.   I just ended up admitting defeat."
Ans: I think you are right track! Ken uses it in open Intro screen, good practice.
Coming to forum when stuck is not exactly caving in to defeat. 

(Interesting about screen 0 using the character placements for mouse pointer as well.   Good to know)
It is!

BTW I didn't try you samples right away, not until ChiaPet's first version. I liked very much first and fith and thought you were close to replicating glider gun creations. The start of using Life for computing ie a Turing Machine. I started with lines but squares or grids might be very interesting, there is probably a perfect spacing for a grid.


I appreciate the response and suggestions...I'll try again, and see if I can get the right mouse click to work.    You can see my attempt at the right click here at 292-298.

Also you can see a glider gun now at option 6.    4-7 are patterns from the Life wiki.   This is very amusing, I had no idea about cellular automata until now.

Code: (Select All)
' Game of Life based on the 1970 game by John Conway, James2464 Aug 2022

Screen _NewImage(1700, 1000, 32)
_ScreenMove (_DesktopWidth - _Width) \ 2, 20
Randomize Timer

$Resize:Off

Const xblack = _RGB32(0, 0, 0)
Const xwhite = _RGB32(255, 255, 255)
Const xred = _RGB32(255, 0, 0)
Const xgreen = _RGB32(125, 255, 125)
Const xblue = _RGB32(0, 0, 255)
Const xyellow = _RGB32(150, 125, 0)
Const xpink = _RGB32(255, 0, 255)
Const xcyan = _RGB32(0, 255, 255)
Const xbrown = _RGB32(80, 0, 0)
Const xdarkgreen = _RGB32(0, 128, 0)
Const xlightgray = _RGB32(110, 110, 110)
Const xdarkgray = _RGB32(10, 10, 10)

Dim c1~&(100)
c1~&(0) = xblack
c1~&(1) = xwhite
c1~&(2) = xred
c1~&(3) = xgreen
c1~&(4) = xblue
c1~&(5) = xyellow
c1~&(6) = xpink
c1~&(7) = xcyan
c1~&(8) = xbrown
c1~&(9) = xdarkgreen
c1~&(10) = xlightgray
c1~&(11) = xdarkgray

'================================================================================================================
'================================================================================================================
'================================================================================================================

'load data patterns

Dim methuselah52513M(16, 16)
For k = 1 To 16
    For j = 1 To 16
        Read methuselah52513M(j, k)
    Next j
Next k

Dim gosper(36, 9)
For k = 1 To 9
    For j = 1 To 36
        Read gosper(j, k)
    Next j
Next k

Dim engineswitch(29, 28)
For k = 1 To 28
    For j = 1 To 29
        Read engineswitch(j, k)
    Next j
Next k




'INITIALIZE

Cls
Dim mn(1000, 800)
Dim dp(1000, 800)
Dim aj(1000, 800)

'grid size
gx = 350
gy = 200
'resolution (1=smallest)
res1 = 4

Cls
xtxt = 20

Locate 10, xtxt
Print "Select starting pattern"
Locate 11, xtxt
Print "1.  Full screen random scatter"
Locate 12, xtxt
Print "2.  Free draw with mouse"
Locate 13, xtxt
Print "3.  Line draw with mouse"
Locate 14, xtxt
Print "4.  Methuselah 52513M"
Locate 15, xtxt
Print "5.  R-Pentomino"
Locate 16, xtxt
Print "6.  Gosper Glider Gun"
Locate 17, xtxt
Print "7.  Block Laying Engine Switch"


Locate 25, xtxt
Input "Choose 1-7: ", start1

'=================== random scatter full
If start1 = 1 Then
    For j = 1 To gx
        For k = 1 To gy
            r = Int(Rnd * 10)
            If r < 3 Then
                mn(j, k) = 1
            Else
                mn(j, k) = 0
            End If
        Next k
    Next j
End If

'=============================== free draw with mouse
If start1 = 2 Then
    'use mouse to draw starting pattern

    'draw STARTING GRID
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j
    Do

        Do While _MouseInput
        Loop
        x% = _MouseX
        y% = _MouseY
        'Locate 1, 1
        'Print x%, y%
        x1 = Int(x% / res1)
        y1 = Int(y% / res1)
        mn(x1, y1) = 1
        'mn(x1 - 1, y1 - 1) = 1
        'mn(x1 + 1, y1 - 1) = 1
        'mn(x1 + 1, y1 + 1) = 1
        'mn(x1, y1 + 1) = 1
        'mn(x1 + 1, y1) = 1
        'mn(x1, y1 - 1) = 1
        'draw  GRID
        For j = 1 To gx
            For k = 1 To gy
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Next k
        Next j

        lc% = _MouseButton(1)
    Loop Until lc% = -1
End If

'=============================== random partial
If start1 = 3 Then

    'use mouse to draw lines
    'left click once to start line
    'left click again to finish line
    'right click when finished

    Cls
    Locate 10, 20
    Print "CREATE HORIZONTAL AND VERTICAL LINES"
    Locate 11, 20
    Print "Instructions:  left click in two places"
    Locate 12, 20
    Print "then the line will appear."
    Locate 14, 20
    Print "press ENTER when finished"
    Locate 15, 20
    Print "then left click TWICE to proceed"
    Locate 20, 20
    Print "press any key to begin"
    Sleep

    'draw STARTING GRID
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    Do
        Do


            Do While lc% = -1
                Do While _MouseInput
                Loop
                lc% = _MouseButton(1)
            Loop


            Do While _MouseInput
            Loop
            x% = _MouseX
            y% = _MouseY
            x1 = Int(x% / res1)
            y1 = Int(y% / res1)
            'Locate 3, 1
            'Print x1, y1
            lc% = _MouseButton(1)
        Loop Until lc% = -1

        'register first point that was clicked
        mn(x1, y1) = 1

        Do While lc% = -1
            Do While _MouseInput
            Loop
            lc% = _MouseButton(1)
        Loop





        Do
            'get second point location

            Do While _MouseInput
            Loop
            x% = _MouseX
            y% = _MouseY
            x2 = Int(x% / res1)
            y2 = Int(y% / res1)
            'Locate 5, 1
            'Print x1; y1; ">"; x2; y2
            lc% = _MouseButton(1)
        Loop Until lc% = -1

        Do While lc% = -1
            Do While _MouseInput
            Loop
            lc% = _MouseButton(1)
        Loop





        'determine if line is horizontal or vertical
        If x2 >= x1 Then xd1 = x2 - x1
        If x2 < x1 Then xd1 = x1 - x2
        If y2 >= y1 Then yd1 = y2 - y1
        If y2 < y1 Then yd1 = y1 - y2

        'create horizontal line
        If xd1 >= yd1 Then
            If x1 < x2 Then
                For j = x1 To x2
                    mn(j, y1) = 1
                Next j
            Else
                For j = x2 To x1
                    mn(j, y1) = 1
                Next j
            End If

        End If



        'create vertical line
        If xd1 < yd1 Then
            If y1 < y2 Then
                For k = y1 To y2
                    mn(x1, k) = 1
                Next k
            Else
                For k = y2 To y1
                    mn(x1, k) = 1
                Next k

            End If

        End If



        'draw  GRID
        For j = 1 To gx
            For k = 1 To gy
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Next k
        Next j



        Do While _MouseInput
        Loop
        _Delay .2
        fl = 0
        rc% = _MouseButton(2)
        If rc% = -1 Then fl = 1
    Loop Until fl = 1


End If

'================================ Methuselah 52513M
If start1 = 4 Then

    'set location
    xp1 = 200
    yp1 = 120

    'draw initial array
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    'update with pattern array at set location xp1,yp1

    For k = 1 To 16
        For j = 1 To 16
            mn(xp1 + j, yp1 + k) = methuselah52513M(j, k)
        Next j
    Next k

End If

'=============================== R-Pentomino
If start1 = 5 Then
    mn(200, 100) = 1
    mn(200, 101) = 1
    mn(201, 102) = 1
    mn(202, 102) = 1
    mn(203, 102) = 1
End If


'================================ Gosper glider gun
If start1 = 6 Then

    'set location
    xp1 = 50
    yp1 = 50

    'draw initial array
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    'update with pattern array at set location xp1,yp1

    For k = 1 To 9
        For j = 1 To 36
            mn(xp1 + j, yp1 + k) = gosper(j, k)
        Next j
    Next k


End If




'================================ Block laying engine switch
If start1 = 7 Then

    'set location
    xp1 = gy - 30
    yp1 = gy - 30

    'draw initial array
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    'update with pattern array at set location xp1,yp1

    For k = 1 To 28
        For j = 1 To 29
            mn(xp1 + j, yp1 + k) = engineswitch(j, k)
        Next j
    Next k


End If





'================================================================================================================
'================================================================================================================
'================================================================================================================

Cls
Locate 10, xtxt
Print "Press space bar to show starting pattern."
Locate 15, xtxt
Print "Then press space bar again to start algorithm."
Locate 16, xtxt
Print "While running, press 't' to toggle to thermal cam view."

Do: _Limit 10
Loop Until Len(InKey$)

'draw STARTING GRID
For j = 1 To gx
    For k = 1 To gy
        Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
    Next k
Next j

Do: _Limit 10
Loop Until Len(InKey$)

'================================================================================================================
'================================================================================================================
'================================================================================================================

Dim As _MEM m0, m1
m0 = _Mem(dp(0, 0))
m1 = _Mem(mn(0, 0))

Do

    'COPY ARRAY

    'For j = 1 To gx
    '    For k = 1 To gy
    '    dp(j, k) = mn(j, k)
    'Next k
    'Next j

    _MemCopy m1, m1.OFFSET, m1.SIZE To m0, m0.OFFSET

    '================ SCAN FIRST ROW =============================

    'top left corner
    aj(1, 1) = dp(1, 2) + dp(2, 1) + dp(2, 2)

    'main portion of top row
    For j = 2 To gx - 1
        aj(j, 1) = dp(j - 1, 1) + dp(j + 1, 1) + dp(j - 1, 2) + dp(j, 2) + dp(j + 1, 2)
    Next j

    'top right corner
    aj(gx, 1) = dp(gx - 1, 1) + dp(gx - 1, 2) + dp(gx, 2)

    '=============SCAN SECOND TO SECOND LAST ROW=================

    For k = 2 To gy - 1

        'scan first position only
        aj(1, k) = dp(1, k - 1) + dp(2, k - 1) + dp(2, k) + dp(2, k + 1) + dp(1, k + 1)

        'scan main portion of current row
        For j = 2 To gx - 1
            aj(j, k) = dp(j - 1, k - 1) + dp(j, k - 1) + dp(j + 1, k - 1) + dp(j - 1, k) + dp(j + 1, k) + dp(j - 1, k + 1) + dp(j, k + 1) + dp(j + 1, k + 1)
        Next j

        'scan end position only
        aj(gx, k) = dp(gx, k - 1) + dp(gx - 1, k - 1) + dp(gx - 1, k) + dp(gx - 1, k + 1) + dp(gx, k + 1)

    Next k

    '======================SCAN LAST ROW=======================

    'bottom left corner
    aj(1, gy) = dp(1, gy - 1) + dp(2, gy - 1) + dp(2, gy)

    'main portion of last row
    For j = 2 To gx - 1
        aj(j, gy) = dp(j - 1, gy) + dp(j + 1, gy) + dp(j - 1, gy - 1) + dp(j, gy - 1) + dp(j + 1, gy - 1)
    Next j

    'bottom right corner
    aj(gx, gy) = dp(gx - 1, gy) + dp(gx - 1, gy - 1) + dp(gx, gy - 1)

    '=======================APPLY RULES AND UPDATE GRID========================

    'rule 1 - if cell was dead and had exactly 3 neighbours, it becomes alive
    'rule 2 - if cell was alive and had <2 or >3 neighbours, it becomes dead

    For k = 1 To gy
        For j = 1 To gx
            If dp(j, k) = 0 Then
                If aj(j, k) = 3 Then
                    mn(j, k) = 1
                End If
            End If
            If dp(j, k) = 1 Then
                If aj(j, k) < 2 Or aj(j, k) > 3 Then
                    mn(j, k) = 0
                End If
            End If
        Next j
    Next k

    '=======================DRAW NEW UPDATED GRID=============================
    For j = 1 To gx
        For k = 1 To gy
            If tog1 = 0 Then
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Else
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(aj(j, k)), BF
            End If
        Next k
    Next j

    _Display
    i$ = InKey$
    If i$ = "t" Then tog1 = tog1 Xor 1

Loop Until i$ = "x"

End


'=========================================== Known patterns from LifeWiki (Conwaylife.com)


'Methuselah 52513M  16x16
Data 1,1,1,0,0,1,1,0,1,0,1,1,0,1,1,1
Data 1,1,0,1,0,1,1,1,0,0,0,0,1,0,1,0
Data 0,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1
Data 0,0,1,0,0,1,1,0,0,0,1,0,0,1,0,0
Data 0,0,1,0,0,0,0,0,1,0,1,0,0,0,1,1
Data 1,0,0,0,0,1,1,0,0,0,1,1,1,0,1,0
Data 0,0,0,1,1,0,0,1,0,0,1,0,1,0,0,1
Data 0,0,1,1,1,1,0,1,0,0,1,0,1,1,0,0
Data 1,1,0,1,1,0,0,1,1,0,0,0,0,0,1,1
Data 1,0,1,1,1,1,0,1,0,0,0,0,1,1,1,0
Data 1,0,0,0,1,1,1,1,0,0,1,1,1,0,0,0
Data 0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1
Data 1,1,0,0,0,1,0,1,1,1,0,1,0,1,1,1
Data 0,1,1,0,1,1,1,1,1,1,0,0,0,1,0,1
Data 1,0,1,0,0,0,0,0,1,1,1,1,0,1,0,0
Data 1,1,1,0,1,0,1,0,1,1,0,0,0,0,0,1


'Gosper glider gun  36x9
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1
Data 1,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,1,1,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0


'Block laying switch engine  29x28
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
Data 0,1,1,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
Data 1,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0
Data 0,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0
Data 0,0,0,1,1,0,1,1,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0
Reply
#20
(08-15-2022, 05:25 AM)Pete Wrote: I've put together several mouse and keyboard routines for SCREEN 0 over the years.

Here is one demo example...

Code: (Select All)
mydemo% = -1
DIM UI AS UserInput

TYPE UserInput
    KeyPress AS STRING
    KeyCombos AS INTEGER
    MbStatus AS INTEGER
    MbEnvoked AS INTEGER
    drag AS INTEGER
    DoubleClick AS INTEGER
    MbLeftx AS INTEGER
    MbLefty AS INTEGER
    mx AS INTEGER
    oldmx AS INTEGER
    my AS INTEGER
    oldmy AS INTEGER
END TYPE

PRINT "Press keys or use mouse for demo.";
DO
    CALL keyboard_mouse(UI, mydemo%)
    IF UI.MbStatus < 0 AND UI.MbEnvoked = 0 THEN
        SOUND 1000, .3: UI.MbEnvoked = -1
    END IF
    IF UI.KeyPress = CHR$(13) THEN BEEP: EXIT DO
LOOP

DO
    CALL keyboard_mouse(UI, mydemo%)
    IF UI.MbStatus > 0 AND UI.MbEnvoked = 0 THEN
        SOUND 300, .3: UI.MbEnvoked = 1
    END IF
LOOP

END

SUB keyboard_mouse (UI AS UserInput, mydemo%)
    STATIC z1, lclick

    _LIMIT 30

    DEF SEG = 0
    IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN
        UI.KeyCombos = 1 ' Shift = -1 ELSE Shift = 0
    ELSEIF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN
        UI.KeyCombos = 2 ' Ctrl = -1 ELSE Ctrl = 0
    ELSEIF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN
        UI.KeyCombos = 3 ' Ctrl+Shift = -1 ELSE Ctrl+Shift = 0
    ELSEIF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
        UI.KeyCombos = 4 ' Alt = -1 ELSE Alt = 0
    ELSEIF PEEK(1047) MOD 16 = 9 OR PEEK(1047) MOD 16 = 10 THEN
        UI.KeyCombos = 5 ' Shift+Alt = -1 ELSE Shift+Alt = -1
    ELSEIF PEEK(1047) MOD 16 = 12 THEN
        UI.KeyCombos = 6 ' Ctrl+Alt = -1 ELSE Ctrl+Alt = 0
    ELSE
        UI.KeyCombos = 0
    END IF
    DEF SEG

    IF mydemo% THEN GOSUB check_UI.KeyCombos

    UI.KeyPress = INKEY$
    IF LEN(UI.KeyPress) THEN ' A key was pressed.
        UI.MbEnvoked = 0: UI.MbLeftx = 0
        SELECT CASE LEN(UI.KeyPress)
            CASE 1 ' 1-byte key A-Z, etc.
                IF mydemo% THEN mydemo% = 1: GOSUB mydemo
                SELECT CASE UI.KeyPress
                    ' Place key selection routine here...
                    CASE CHR$(27): SYSTEM
                END SELECT
            CASE 2 '2-byte key F1-F12, etc.
                IF mydemo% THEN mydemo% = 2: GOSUB mydemo
                SELECT CASE RIGHT$(UI.KeyPress, 1)
                    ' Place key selection routine here...
                END SELECT
        END SELECT
    ELSE ' Check for mouse input since no keyboard input was detected.

        IF lclick THEN ' Check timer for double-clicks.
            IF TIMER < z1 THEN z1 = z1 - 86400 ' Midnight adjustment.
            IF TIMER - z1 > .33 THEN lclick = 0 ' Too much time ellapsed for a double click.
        END IF

        WHILE _MOUSEINPUT
            mw = mw + _MOUSEWHEEL ' Check for mouse wheel use.
        WEND

        ' Get mouse status.
        UI.mx = _MOUSEX
        UI.my = _MOUSEY
        lb = _MOUSEBUTTON(1)
        rb = _MOUSEBUTTON(2)
        mb = _MOUSEBUTTON(3)

        SELECT CASE UI.MbEnvoked
            CASE 0
                IF lb OR rb OR mb THEN

                END IF
            CASE 1
                IF lb OR rb OR mb THEN UI.MbEnvoked = 0
            CASE -1
                IF lb = 0 AND rb = 0 AND mb = 0 THEN UI.MbEnvoked = 0
        END SELECT

        ' Check for mouse movement.
        IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN
            oldcsrlin = CSRLIN: oldpos = POS(0)
            LOCATE 3, 1: PRINT "Mouse row/col ="; UI.my; UI.mx; "     ";: LOCATE oldcsrlin, oldpos
        END IF

        IF UI.MbStatus < 0 THEN ' Mouse button pressed. UI.MbStatus identity is by number. -1=left, -2=right, -3=middle.
            SELECT CASE UI.MbStatus
                CASE -1 ' Left button was pressed.
                    IF lb = 0 THEN ' Left button released.
                        SELECT CASE lclick ' Single or double click analysis.
                            CASE 0
                                IF mydemo% THEN mydemo% = 3: GOSUB mydemo
                                lclick = lclick + 1
                            CASE ELSE ' Double click. Completed upon 2nd left button release.
                                IF mydemo% THEN mydemo% = 11: GOSUB mydemo
                                UI.DoubleClick = -1
                                lclick = 0
                        END SELECT
                        UI.MbStatus = 1

                        IF UI.MbLeftx THEN
                            IF UI.mx <> UI.MbLeftx OR UI.my <> UI.MbLefty THEN UI.MbStatus = 0: lclick = 0
                            UI.MbLeftx = 0: UI.MbLefty = 0
                        END IF

                        IF UI.drag THEN UI.drag = 0
                    ELSE ' Left button is being held down. Check for UI.drag.
                        IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN ' Mouse cursor has moved. UI.drag.
                            IF mydemo% THEN mydemo% = 12: GOSUB mydemo
                            UI.drag = -1
                        END IF
                    END IF
                CASE -2 ' Right button was pressed.
                    IF rb = 0 THEN ' Right button was relased.
                        IF mydemo% THEN mydemo% = 4: GOSUB mydemo
                        UI.MbStatus = 2
                    END IF
                CASE -3 ' Middle button was pressed
                    IF mb = 0 THEN ' Middle button was released.
                        IF mydemo% THEN mydemo% = 5: GOSUB mydemo
                        UI.MbStatus = 3
                    END IF
            END SELECT
        ELSE
            IF lb THEN ' Left button just pressed.
                IF mydemo% THEN mydemo% = 6: GOSUB mydemo
                UI.MbStatus = -1
                IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
                z1 = TIMER
            ELSEIF rb THEN ' Right button just pressed.
                IF mydemo% THEN mydemo% = 7: GOSUB mydemo
                IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
                UI.MbStatus = -2
            ELSEIF mb THEN ' Middle button just pressed.
                IF mydemo% THEN mydemo% = 8: GOSUB mydemo
                IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
                UI.MbStatus = -3
            ELSEIF mw THEN ' Mouse wheel just moved.
                SELECT CASE mw
                    CASE IS > 0 ' Scroll down.
                        IF mydemo% THEN mydemo% = 9: GOSUB mydemo
                    CASE IS < 0 ' Scroll up.
                        IF mydemo% THEN mydemo% = 10: GOSUB mydemo
                END SELECT
            END IF
        END IF

        UI.oldmx = UI.mx: UI.oldmy = UI.my: mw = 0 ' Mouse position past and present.
    END IF
    EXIT SUB

    mydemo:
    LOCATE 1, 1: PRINT "Last User Status:                                    ";
    LOCATE , 19
    SELECT CASE mydemo%
        CASE 1
            PRINT "1-byte Key = "; UI.KeyPress
        CASE 2
            PRINT "2-byte Key = "; UI.KeyPress
        CASE 3
            PRINT "Left button released."
        CASE 4
            PRINT "Right button released."
        CASE 5
            PRINT "Middle button released."
        CASE 6
            PRINT "Left button down."
        CASE 7
            PRINT "Right button down."
        CASE 8
            PRINT "Middle button down."
        CASE 9
            PRINT "Wheel scroll down."
        CASE 10
            PRINT "Wheel scroll up."
        CASE 11
            PRINT "Left button double click."
        CASE 12
            PRINT "Drag..."
    END SELECT
    mydemo% = -1
    RETURN

    check_UI.KeyCombos:
    IF UI.KeyCombos THEN
        LOCATE 1, 50
        SELECT CASE UI.KeyCombos
            CASE 1
                PRINT "Shift key down.        ";
            CASE 2
                PRINT "Ctrl key down.         ";
            CASE 3
                PRINT "Ctrl + Shift keys down. ";
            CASE 4
                PRINT "Alt key down.          ";
            CASE 5
                PRINT "Alt + Shift keys down.  ";
            CASE 6
                PRINT "Ctrl + Alt keys down."
        END SELECT
    ELSE
        LOCATE 1, 50: PRINT SPACE$(29);
    END IF
    RETURN
END SUB


Pete

What an excellent reference...thank you.   

I have no idea but I'm wondering how much of this can be used in "screen _newimage" mode.   
Screen 0 potential seems amazing, I definitely need to explore this
Reply




Users browsing this thread: 7 Guest(s)