Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Minimal Text Animator
#1
Minimal Text Animator is exactly what this is. This is a very simple program to create and playback animations in 80x25 text mode. 
It's simply structured with a main input loop, functions and subroutines are called from that loop. I want beginners to be able to look at this and modify it for their own needs. Currently there isn't much in the way of comments and there's a couple other commands I want to add but it certainly is a Minimal Text Animator right now. 

Currently the user can Save and Load files, change the pen foreground and background color, change the character being drawn, and change the framerate. It's currently limited to 200 frames but that can easily be modified (just keep memory use and file size in mind). 

Code: (Select All)
'Minimal Text Animator
'by James D. Jarvis Sept 15,2022   v 0.1
'
' a very minimal program to create and playback simple text screen animations
'S - Save file
'L - load file
'use mosue to draw
'N,n - create a new frame    (limited to 200 as coded but you can edit that if you wish
'P,p - play animation
'F,f - change pen foreground color , you'll have to enter color number afterward
'B,b - change pen background color, you'll have to enter color number afterward
'esc - to quit program.... be careful this just dumps you out and you'll lose any work currently
'
'nothing fancy here at all, just a minimal program that functions

Screen _NewImage(80, 25, 0)
_Title "Minimal Text Animator"
Type gcelltype
    t As String * 1
    fgk As _Byte
    bgk As _Byte
End Type
Dim Shared maxtx, maxty, maxframes, pen$, fg_klr, bg_klr, pen_klr
Dim Shared showonion, framerate, lastframe
framerate = 20
maxtx = _Width
maxty = _Height
maxframes = 200
pen$ = "*"
showonion = 0
Print "Minimal Text Animator"
_ControlChr Off
Dim Shared gcell(maxframes, maxtx, maxty) As gcelltype
For f = 1 To maxframes
    For y = 1 To _Height
        For x = 1 To _Width
            gcell(f, x, y).t = " "
            gcell(f, x, y).fgk = 15
            gcell(f, x, y).bgk = 0
        Next x
    Next y
Next f
frameno = 1
fg_klr = 15
bg_klr = 0
pen_klr = 15
Color fg_klr, bg_klr
'main program loop
Do
    _Limit 60
    Do While _MouseInput '      Check the mouse status
        If _MouseButton(1) Then 'draw that square if the
            mx = _MouseX: my = _MouseY
            gcell(frameno, mx, my).t = pen$
            gcell(frameno, mx, my).fgk = pen_klr
            gcell(frameno, mx, my).bgk = bg_klr
            Color pen_klr, gcell(frameno, mx, my).bgk
            _PrintString (mx, my), gcell(frameno, mx, my).t
        End If
        Color 15, 0
    Loop
    Select Case kk$
        Case "n", "N"
            Cls
            frameno = frameno + 1
            If frameno > maxframes Then frameno = 1
            If showonion = 1 And frameno > 1 Then drawonion (frameno - 1)
            drawframe frameno
            lastframe = frameno
        Case "o", "O"
            If showonion = 0 Then
                Cls
                showonion = 1
                drawonion (frameno - 1)
                drawframe frameno
            Else
                showonion = 0
            End If
        Case "p", "P" 'play the animation
            playanimation 1, lastframe

        Case ",", "<" 'cycle down through drawn frames
            frameno = frameno - 1
            If frameno < 1 Then frameno = lastframe
            drawframe frameno
        Case ".", ">" 'cycle up through drawn frames
            frameno = frameno + 1
            If frameno > lastframe Then frameno = 1
            Cls
            drawframe frameno
        Case "f", "F"
            pen_klr = select_pencolor
            Cls
            drawframe frameno
        Case "b", "B"
            bg_klr = select_backgroundcolor
            Cls
            drawframe frameno
        Case "S"
            savefile
            Cls
            drawframe frameno
        Case "L"
            loadfile
            Cls
            playanimation 1, lastframe
            frameno = 1
        Case "h", "H", "?"
            helpme
            Cls
            drawframe frameno
        Case "r", "R"
            framerate = newrate
            Cls
            drawframe frameno
        Case "c", "C"
            pen$ = Chr$(newchar)
            Cls
            drawframe frameno
    End Select
    kk$ = InKey$
    If kk$ = "f" Then _PrintString (1, 1), Str$(frameno)
Loop Until kk$ = Chr$(27)
Sub drawframe (f As Integer)
    For y = 1 To _Height
        For x = 1 To _Width
            If onion = 0 Then
                Color gcell(f, x, y).fgk, gcell(f, x, y).bgk
                _PrintString (x, y), gcell(f, x, y).t
            Else
                If gcell(f, x, y).t <> " " Then
                    Color gcell(f, x, y).fgk, gcell(f, x, y).bgk
                    _PrintString (x, y), gcell(f, x, y).t
                End If
            End If
        Next
    Next
    Color 15, 0
End Sub
Sub drawonion (f As Integer)
    For y = 1 To _Height
        For x = 1 To _Width
            Color 8, 0
            _PrintString (x, y), gcell(f, x, y).t
        Next
    Next
    Color 15, 0
End Sub
Sub playanimation (ff, lf)
    For f = ff To lf
        Cls
        _Limit framerate
        For y = 1 To _Height
            For x = 1 To _Width
                Color gcell(f, x, y).fgk, gcell(f, x, y).bgk
                _PrintString (x, y), gcell(f, x, y).t
            Next
        Next
        _Display
    Next f
    _AutoDisplay
    Color 15, 0
End Sub
Function select_pencolor
    Cls
    Color 15, 0
    Print "SELECT PEN COLOR"
    Print
    Print " 0.",: Color 0, 0: Print Chr$(219),: Color 15, 0: Print "16.",: Color 16, 0: Print Chr$(219): Color 15, 0
    Print " 1.",: Color 1, 0: Print Chr$(219),: Color 15, 0: Print "17.",: Color 17, 0: Print Chr$(219): Color 15, 0
    Print " 2.",: Color 2, 0: Print Chr$(219),: Color 15, 0: Print "18.",: Color 18, 0: Print Chr$(219): Color 15, 0
    Print " 3.",: Color 3, 0: Print Chr$(219),: Color 15, 0: Print "19.",: Color 19, 0: Print Chr$(219): Color 15, 0
    Print " 4.",: Color 4, 0: Print Chr$(219),: Color 15, 0: Print "20.",: Color 20, 0: Print Chr$(219): Color 15, 0
    Print " 5.",: Color 5, 0: Print Chr$(219),: Color 15, 0: Print "21.",: Color 21, 0: Print Chr$(219): Color 15, 0
    Print " 6.",: Color 6, 0: Print Chr$(219),: Color 15, 0: Print "22.",: Color 22, 0: Print Chr$(219): Color 15, 0
    Print " 7.",: Color 7, 0: Print Chr$(219),: Color 15, 0: Print "23.",: Color 23, 0: Print Chr$(219): Color 15, 0
    Print " 8.",: Color 8, 0: Print Chr$(219),: Color 15, 0: Print "24.",: Color 24, 0: Print Chr$(219): Color 15, 0
    Print " 9.",: Color 9, 0: Print Chr$(219),: Color 15, 0: Print "25.",: Color 25, 0: Print Chr$(219): Color 15, 0
    Print "10.",: Color 10, 0: Print Chr$(219),: Color 15, 0: Print "26.",: Color 26, 0: Print Chr$(219): Color 15, 0
    Print "11.",: Color 11, 0: Print Chr$(219),: Color 15, 0: Print "27.",: Color 27, 0: Print Chr$(219): Color 15, 0
    Print "12.",: Color 12, 0: Print Chr$(219),: Color 15, 0: Print "28.",: Color 28, 0: Print Chr$(219): Color 15, 0
    Print "13.",: Color 13, 0: Print Chr$(219),: Color 15, 0: Print "29.",: Color 29, 0: Print Chr$(219): Color 15, 0
    Print "14.",: Color 14, 0: Print Chr$(219),: Color 15, 0: Print "30.",: Color 30, 0: Print Chr$(219): Color 15, 0
    Print "15.",: Color 15, 0: Print Chr$(219),: Color 15, 0: Print "31.",: Color 31, 0: Print Chr$(219): Color 15, 0
    Do
        Locate 20, 3: Input "enter color from 0 to 31 ", kk$
    Loop Until Val(kk$) > -1 Or Val(kk$) < 32
    select_pencolor = Val(kk$)
End Function
Function newrate
    Cls
    Print "Change Frame Rate ?"
    Print
    Print "Current frame rate is "; framerate
    Print
    Do
        Locate 20, 3: Input "enter color from 1 to 60 ", kk$
    Loop Until Val(kk$) > 0 Or Val(kk$) < 61
    newrate = Val(kk$)
End Function

Function select_backgroundcolor
    Cls
    Color 15, 0
    Print "SELECT Background COLOR"
    Print
    Print " 0.",: Color 0, 0: Print Chr$(219),: Color 15, 0
    Print " 1.",: Color 1, 0: Print Chr$(219): Color 15, 0
    Print " 2.",: Color 2, 0: Print Chr$(219),: Color 15, 0
    Print " 3.",: Color 3, 0: Print Chr$(219): Color 15, 0
    Print " 4.",: Color 4, 0: Print Chr$(219),: Color 15, 0
    Print " 5.",: Color 5, 0: Print Chr$(219): Color 15, 0
    Print " 6.",: Color 6, 0: Print Chr$(219),: Color 15, 0
    Print " 7.",: Color 7, 0: Print Chr$(219): Color 15, 0
    Print " 8.",: Color 8, 0: Print Chr$(219),: Color 15, 0
    Print " 9.",: Color 9, 0: Print Chr$(219): Color 15, 0
    Print "10.",: Color 10, 0: Print Chr$(219),: Color 15, 0
    Print "11.",: Color 11, 0: Print Chr$(219): Color 15, 0
    Print "12.",: Color 12, 0: Print Chr$(219),: Color 15, 0
    Print "13.",: Color 13, 0: Print Chr$(219): Color 15, 0
    Print "14.",: Color 14, 0: Print Chr$(219),: Color 15, 0
    Print "15.",: Color 15, 0: Print Chr$(219): Color 15, 0
    Do
        Locate 20, 1: Input "enter color from 0 to 31", kk$
    Loop Until Val(kk$) > -1 Or Val(kk$) < 32
    select_backgroundcolor = Val(kk$)
End Function
Sub helpme
    Cls
    Print "HELP"
    Print
    Print "S - Save file   "
    Print "L - load file   "
    Print "use mosue to draw"
    Print "N,n - create a new frame    (limited to 200 as coded but you can edit that if you wish"
    Print "P,p - play animation"
    Print "C,c - change pen foreground color , you'll have to enter color number afterward"
    Print "B,b - change pen background color, you'll have to enter color number afterward"
    Print "R,r - change framerate for animation"
    Print "esc - to quit program.... be careful this just dumps you out and you'll lose any work currently"
    Print
    Print "Press any key to continue"
    any$ = Input$(1)
End Sub
Function newchar
    Dim mc(0 To 256, 2)
    Cls
    x = 0
    y = 3
    newc = -1
    Print "Click on the Character you wish to use."
    For c = 0 To 255
        x = x + 2
        If x > 60 Then
            x = 2
            y = y + 2
        End If
        _PrintString (x, y), Chr$(c)
        mc(c, 1) = x
        mc(c, 2) = y
    Next c
    Do
        _Limit 60
        Do While _MouseInput '      Check the mouse status
            If _MouseButton(1) Then 'draw that square if the
                mx = _MouseX: my = _MouseY
                c = 0
                Do
                    If mc(c, 1) = mx And mc(c, 2) = my Then newc = c
                    c = c + 1
                    If c = 256 Then newc = -2
                Loop Until newc <> -1
                If newc = -2 Then newc = -1

            End If
            Color 15, 0
        Loop
    Loop Until newc <> -1
    newchar = newc
End Function

Sub savefile
    Locate 1, 1
    Print "Enter file name "
    Locate 2, 1
    Input filename$
    Open filename$ For Output As #1
    Write #1, framerate, maxtx, maxty, lastframe
    For f = 1 To lastframe
        For y = 1 To maxty
            For x = 1 To maxtx
                Write #1, gcell(f, x, y).t, gcell(f, x, y).fgk, gcell(f, x, y).bgk
                Print gcell(f, x, y).t, gcell(f, x, y).fgk, gcell(f, x, y).bgk
            Next x
        Next y

    Next f
    Close #1
    Locate 3, 1
    Print filename$; " saved"
    Print "press any key to continue"
    any$ = Input$(1)
End Sub
Sub loadfile
    Locate 1, 1
    Print "Enter file name "
    Locate 2, 1
    Input filename$
    Open filename$ For Input As #1
    Input #1, framerate, maxtx, maxty, lastframe
    For f = 1 To lastframe
        For y = 1 To maxty
            For x = 1 To maxtx
                Input #1, gcell(f, x, y).t, gcell(f, x, y).fgk, gcell(f, x, y).bgk
                Print gcell(f, x, y).t, gcell(f, x, y).fgk, gcell(f, x, y).bgk
            Next x
        Next y
    Next f
    Close #1
    Locate 3, 1
    Print filename$; " loaded"
    Print "press any key to continue"
    any$ = Input$(1)
End Sub
Reply


Messages In This Thread
Minimal Text Animator - by James D Jarvis - 09-15-2022, 08:42 PM
RE: Minimal Text Animator - by James D Jarvis - 09-15-2022, 10:32 PM
RE: Minimal Text Animator - by James D Jarvis - 09-16-2022, 03:33 AM
RE: Minimal Text Animator - by James D Jarvis - 09-16-2022, 04:55 PM
RE: Minimal Text Animator - by Pete - 09-16-2022, 05:17 PM
RE: Minimal Text Animator - by James D Jarvis - 09-16-2022, 07:12 PM



Users browsing this thread: 3 Guest(s)