Personaje

[mnrvovrfc]

I created a quick-and-dirty drawing program. It's in SCREEN 0 and uses the mouse. Draw on the first 48 lines. More explanations below this code block.

NOTE: We need users of MacOS to check things out: where documents and fonts are stored by default.

Code: (Select All)

'by mnrvovrfc 22-Jan-2023
option _explicit
dim shared as integer x, y, ch
dim as _byte lb, rb
dim shared recal as _byte, beginpath as string
dim ascr$, opt$, afont as long

$IF WIN THEN
    beginpath = environ$("USERPROFILE") + "\Documents"
$ELSEIF LINUX THEN
    beginpath = environ$("HOME") + "/Documents"
$ELSE
    'might be enough to take out "Library/"
    beginpath = "/Users/" + environ$("USER") + "/Library/Documents"
$END IF

_delay 0.5
_title "Quick Draw"
width 80, 50

ascr$ = command$(1)
if ascr$ <> "" then
    lb = 0 : rb = 0
    if lcase$(ascr$) = "empty" then
        rb = 1
        ascr$ = ""
    elseif _fileexists(ascr$) then
        rb = 1
    end if
    opt$ = lcase$(command$(2))
    if opt$ <> "" then
        if left$(opt$, 2) = "--" then
            lb = 3
        elseif left$(opt$, 1) = "-" then
            lb = 2
        else
            lb = 0
        end if
        if lb > 0 then
            if mid$(opt$, lb, 4) = "font" then
$IF WIN THEN
                afont = _loadfont("C:\Windows\Fonts\lucon.ttf", 14, "monospace")
$ELSEIF LINUX THEN
                ''LOL assumes Manjaro Linux
                afont = _loadfont("/usr/share/fonts/liberation/LiberationMono-Regular.ttf", 14, "monospace")
$ELSE
                ''this has to be tested!
                ''from: https://alvinalexander.com/macos/what-is-mac-fonts-folder-install-new-fonts/
                afont = _loadfont("/Users/" + environ$("USER") + "/Library/Fonts/liberation/LiberationMono-Regular.ttf", 14, "monospace")
$END IF
                if afont > 0 then _font afont
            end if
            if rb and ascr$ <> "" then
                if mid$(opt$, lb, 5) = "strip" then
                    loaddraw2 ascr$, 1
                else
                    loaddraw2 ascr$, 0
                end if
            end if
        end if  'if there's a proper option
    else
        if rb and ascr$ <> "" then
            loaddraw2 ascr$, 0
        end if
    end if  'if there's any option
end if  'if filename to load or "empty" is provided at command line

ch = 35
if _fileexists("quickdraw00000.txt") then kill "quickdraw00000.txt"


do
    _limit 500
    showstatusbar
    do : loop while _mouseinput
    x = _mousex
    y = _mousey
    lb = _mousebutton(1)
    rb = _mousebutton(2)
    if lb < 0 then
        if y < 49 then
            locate y, x : print chr$(ch);
        else
            if x < 4 then
                ch = ch - 1
                if ch < 32 then ch = 254
                _delay 0.15
            elseif x > 5 and x < 9 then
                ch = ch + 1
                if ch > 254 then ch = 32
                _delay 0.15
            elseif x > 31 and x < 37 then
                _delay 0.2
                lb = _messagebox("Clear screen", "Are you sure?", "yesno", "info")
                if lb = 1 then cls
            elseif x > 39 and x < 44 then
                _delay 0.2
                savedraw 0
            elseif x > 35 and x < 50 then
                _delay 0.2
                loaddraw 0
            elseif x > 52 and x < 58 then
                _delay 0.2
                savedraw 1
            elseif x > 60 and x < 66 then
                _delay 0.2
                loaddraw 1
            end if
        end if
    elseif rb < 0 then
        if y < 49 then
            locate y, x : print " ";
        end if
    end if
loop until inkey$ = chr$(27)
if afont > 0 then
    _font 8
    _freefont afont
end if
system


sub showstatusbar ()
    locate 49, 1
    print "<  "; chr$(ch); "  > ";
    print using "col = ##, row = ##"; x, y;
    locate 49, 31
    print "|CLEAR|||SAVE|LOAD|||STORE|";
    if recal then print "RECAL|";
end sub

''CHANGED: a$
sub savescreen (a$)
    dim i as integer
    a$ = ""
    for i = 1 to 3840
        a$ = a$ + chr$(screen(((i - 1) \ 80) + 1, ((i - 1) mod 80) + 1))
    next
end sub

sub loadscreen (a$)
    locate 1, 1
    print a$:
end sub

sub savedraw (haut as _byte)
    static underscores$
    dim a$, b$, ff as long, x as integer, y as integer, c as integer, d as integer
    if underscores$ = "" then underscores$ = string$(80, 95)
    if haut then
        a$ = "quickdraw00000.txt"
    else
        a$ = _savefiledialog$("Enter a filename to save to", beginpath, "*.txt", "TEXT FILES")
        if a$ = "" then exit sub
    end if
    ff = freefile
    open a$ for output as ff
    for y = 1 to 48
        d = 95
        b$ = ""
        for x = 1 to 80
            c = screen(y, x)
            if haut = 0 then
                if c = 32 then
                    c = d
                elseif c <> 32 and d = 95 then
                    d = 32
                end if
            end if
            b$ = b$ + chr$(c)
        next
        if b$ = underscores$ then
            print #ff, ""
        else
            print #ff, rtrim$(b$)
        end if
    next
    if haut then recal = 1
    close ff
end sub

sub loaddraw (haut as _byte)
    dim a$, b$, ff as long, y as integer
    if haut then
        a$ = "quickdraw00000.txt"
        if not _fileexists(a$) then exit sub
    else
        a$ = _openfiledialog$("Choose a text file to restore", beginpath, "*.txt", "TEXT FILES")
        if a$ = "" then exit sub
    end if
    cls
    y = 1
    ff = freefile
    open a$ for input as ff
    do until eof(ff)
        line input #ff, b$
        locate y, 1
        print b$;
        y = y + 1
        if y > 48 then exit do
    loop
    close ff
end sub

sub loaddraw2 (afile as string, ustrip as _byte)
    dim b$, ff as long
    dim as integer v, w, x, y
    y = 1
    if ustrip then
        x = 32766
        ff = freefile
        open afile for input as ff
        do until eof(ff)
            line input #ff, b$
            if b$ <> "" then
                if left$(b$, 1) = "_" then
                    w = 0
                    for v = 1 to len(b$)
                        if mid$(b$, v, 1) <> "_" then w = v : exit for
                    next
                    if w > 0 and w < x then x = w
                end if
            end if
            y = y + 1
            if y > 48 then exit do
        loop
        close ff
    else
        x = 1
    end if
    ff = freefile
    open afile for input as ff
    do until eof(ff)
        line input #ff, b$
        locate y, 1
        if ustrip then
            print mid$(b$, x);
        else
            print b$;
        end if
        y = y + 1
        if y > 48 then exit do
    loop
    close ff
end sub

This program displays a status bar at the bottom of the screen. "Save" and "load" buttons clicked on screen do what they are asked. "Save" puts underscores at the front of lines where CHR$(32) spaces are. Use the arrow buttons at the extreme bottom left of the screen to change the current character for the pen. (A good improvement here is to use "_MOUSEWHEEL" function but I can only use a touchpad.) Press left mouse button to draw and right mouse button to erase. Press "clear" with left mouse button to clear the screen, but before that must answer "yes" to the prompt. Press [ESC] to quit the program.

The "store" and "recall" buttons are like "save" and "load" but always save to a specific file in the same directory as this program's executable. Before "messing it up" hit "STORE" with left mouse button. You'll notice "RECAL" appears next to "STORE" button. After that, if fixing the picture is too much just press "RECAL". It was hard for me to come up with a "proper" undo function. I had one which saved the current buffer every 10 seconds and reset the timer everytime the user drew something on the screen, but it was too tricky and some of you would have requested multiple buffers. The "savescreen" and "loadscreen" subprograms have been left alone in this program, and it was a hint of the undo function.

The "recall" file is erased if it's found by this program in the same directory. That's why you need to "STORE" first.

This program always saves text files with underscores replacing leading spaces. To get rid of them when loading back into this program, at the command line offer the name of the file as first parameter, then "-strip" or "--strip" as the second parameter. This maintains some of the underscores however, so the picture remains aligned with the left-hand side of the window. Otherwise to really get rid of them all, use the search-and-replace of your text editor or word processor.

The "-font" option is going to require some feedback. At the moment on Linux this was composed and tested only on Manjaro. The paths are going to be different at least on anything based on Debian or Fedora, and some independent distros. I looked up one page to write where the fonts might be stored on a Macintosh but it might not be accurate. The open file requester on MacOS might also not open in the user's "Documents" directory because I don't have a Macintosh and therefore don't know where this could be for a given user.

The command line requires the name of an existing file on disk. To override that to be able to use "-font" option, use "empty" as the filename.

The font size cannot be larger than 14 on a screen which is only 768 pixels high such as a laptop. If you have a much bigger screen, feel free to change that setting. The screen set by this program as it stands will at least be the 8x8 font for 80x50 SCREEN 0.