Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Ascii ClipDoodle (text screen art)
#1
A multi-window program to draw ASCII-art. 
The program consists of the main program and 2 other programs that must also be compiled for this to function properly.

sorry V0.2 for Windows only due to the clipboard use.  V0.3 doesn't use the clipboard commands

Thanks to SMcNeil for the excellent text screen saving routines.

EDIT: V0.3 entries for all 3 programs are in a later post to this thread. Hopefully it will work on other systems.

[Image: image.png]


Code: (Select All)
'Ascii Clipdoodle  V 0.2
'an ascii doodle pad that opens control panel apps in other windows
'
'sorry windows only
'
'loadtextimage and savetextimage from SMcNeil at  https://qb64phoenix.com/forum/showthread.php?tid=2022
'
'pickclip.exe and colorpick16.exe must be compiled before this program will function properly

Dim Shared reflag
reflag = -1
Dim Shared helpscreen As Long
Dim Shared twd, tht

twd = 80: tht = 25
helpscreen = _NewImage(twd, tht, 0)

Dim Shared mainscreen As Long
mainscreen = _NewImage(80, 25, 0) 'default size text screen. feel free to change it.
Screen mainscreen
_Title "Ascii ClipDoodle"
Cls
_Clipboard$ = "ClipDoodleOn" ' "clears" clipboard for use
Shell _DontWait "pickclip.exe" ' Open the pickclip control panel
Shell _DontWait "colorpick16.exe" ' Open the colorpick16 control panel
_ControlChr Off
AK = 42
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        _Limit 2000
        x = _MouseX
        y = _MouseY
        px = _MouseX: py = _MouseY
        If _MouseButton(1) Then
            _PrintString (x, y), brush$
        End If
    Loop
    kk$ = InKey$
    Select Case kk$
        Case "t", "T" 'type on current line with current color characteristics
            _KeyClear
            Do
                Do
                    _Limit 60
                    tk$ = InKey$
                Loop Until tk$ <> ""
                If tk$ = Chr$(8) Then
                    tk$ = ""
                    px = px - 1
                End If
                If tk$ <> Chr$(13) And tk$ <> "" Then
                    _PrintString (px, py), tk$
                    px = px + 1
                    If px > _Width Then tk$ = Chr$(13) 'exit type input if attempting to type outside screen
                End If
            Loop Until tk$ = Chr$(13)
        Case "S" 'save text screen
            filef = 0
            file$ = _SaveFileDialog$("Save File", "", "*.SAV", "SAved text screen")
            If file$ <> "" Then
                filef = 1
                _MessageBox "Information", "File will be saved to " + file$
            End If
            If filef = 1 Then
                SaveTextImage 0, file$
                _MessageBox "Image SAved", "Text Images SAVED to " + file$
            End If
            filef = 0
        Case "L", "O" 'load text screen
            file$ = _OpenFileDialog$("Open File", "", "*.SAV", "SAVed text screen", -1)
            If file$ <> "" Then
                _MessageBox "Information", "You selected " + file$
                'mainscreen = LoadTextImage(file$)
                Screen LoadTextImage(file$)
                tht = _Height
                twid = _Width
            End If

        Case "C" 'clear screen
            cc = _MessageBox("CLEAR SCREEN", "Are you sure you want to clear the screen? The image will be lost if it has not been saved. ", "yesnocancel", "warning", 0)
            If cc = 1 Then Cls
        Case Chr$(27)
            cc = _MessageBox("QUIT !", "Are you sure you wish to QUIT? The image will be lost if it has not been saved. ", "yesnocancel", "warning", 0)
            If cc = 1 Then Else kk$ = ""

        Case "R"
            do_resize
        Case "?" 'help
            do_help
    End Select

    ik$ = _Clipboard$
    If Left$(ik$, 2) = "AC" Then AK = Val(Right$(ik$, Len(ik$) - 2))
    If Left$(ik$, 2) = "CK" Then
        ff$ = " "
        n = 2
        Do
            n = n + 1
            A$ = Mid$(ik$, n, 1)
            If A$ <> "/" Then ff$ = ff$ + A$
        Loop Until A$ = "/"
        bb$ = ""
        Do
            A$ = Mid$(ik$, n, 1)
            If A$ <> "/" Then bb$ = bb$ + A$
            n = n + 1
        Loop Until n > Len(ik$)
        FG = Val(ff$): BG = Val(bb$)
        Color FG, BG
    End If
    brush$ = Chr$(AK)
Loop Until kk$ = Chr$(27)
_Clipboard$ = "QUITCOLORPICK16"
Sleep 1
_Clipboard$ = "QUITCLIPPICK"
System
Sub do_help
    ls& = _Dest
    Screen helpscreen
    Cls
    Print "HELP"
    Print "------------------"
    Print "use mouse to draw with ascii characters"
    Print "select character to draw and colors from control panels"
    Print " "
    Print "<ESC> to quit program"
    Print "t,T  -  To type a line of text in colors picked"
    Print
    Print "S    - To Save Screen"
    Print "L,O  - to Load Saved Screen"
    Print "C    - to clear screen"
    print "R    - to Resize Screen   (WARNING : DESTRUCTIVE)"
    Print
    Print "press any key to continue"
    Sleep
    Screen ls&
End Sub
Sub do_resize
    ls& = _Dest
    Screen helpscreen
    Cls
    Print "Resize"
    Print "------------------"
    Print "Current size "
    Print "width "; twd, "Height "; tht
    Print "Enter new coordinates"
    Input "Width "; twd
    Input "Height"; tht
    _FreeImage ls&

    Screen _NewImage(twd, tht, 0)
End Sub




Function LoadTextImage& (SaveFile As String) 'create and load to a new Screen 0 screen with our saved image
    Dim As Integer Wide, Tall, Flag: Wide = 80: Tall = 25: Flag = 0
    Dim As String ImageData
    Dim As _MEM M
    f = FreeFile
    Open SaveFile For Binary As #f
    compress$ = Space$(LOF(f))
    Get #f, 1, compress$
    Close #f
    temp$ = _Inflate$(compress$)
    Flag = Asc(temp$, 1): p = 2

    If Flag And 1 Then Wide = CVI(Mid$(temp$, p, 2)): p = p + 2
    If Flag And 2 Then Tall = CVI(Mid$(temp$, p, 2)): p = p + 2
    If Flag And 4 Then _Blink On Else _Blink Off
    If Flag And 8 Then _Font Asc(temp$, p): p = p + 1
    ImageData = Mid$(temp$, p)
    TempImage = _NewImage(Wide, Tall, 0)
    M = _MemImage(TempImage): _MemPut M, M.OFFSET, ImageData: _MemFree M
    LoadTextImage = TempImage
End Function

Sub SaveTextImage (ImageHandle As Long, SaveFile As String)
    Dim As Integer Wide, Tall, Flag
    Dim As Long ImageSize
    Dim As String ImageData
    Dim As _MEM M
    If _PixelSize(ImageHandle) <> 0 Then Error 5: Exit Sub 'only text images for this routine

    M = _MemImage(ImageHandle)
    Wide = _Width(ImageHandle): Tall = _Height(ImageHandle)
    temp$ = "0" 'placeholder for our finalized image flag which holds custom information

    If Wide <> 80 Then Flag = Flag + 1: temp$ = temp$ + MKI$(Wide)
    If Tall <> 25 Then Flag = Flag + 2: temp$ = temp$ + MKI$(Tall)
    If _Blink Then Flag = Flag + 4 'Set a flag saying that this image uses _Blink
    Select Case _Font(ImageHandle)
        Case 8: Flag = Flag + 8: temp$ = temp$ + Chr$(8)
        Case 9: Flag = Flag + 8: temp$ = temp$ + Chr$(9)
        Case 14: Flag = Flag + 8: temp$ = temp$ + Chr$(14)
        Case 15: Flag = Flag + 8: temp$ = temp$ + Chr$(15)
        Case 16 '16 needs no flag as it's the default for screen 0
        Case 17: Flag = Flag + 8: temp$ = temp$ + Chr$(17)
        Case Else
            'To be added once we get a _MemFont to retrieve custom font data back from QB64PE
    End Select
    ImageSize = Wide * Tall * 2
    ImageData = Space$(ImageSize): _MemGet M, M.OFFSET, ImageData: _MemFree M
    temp$ = temp$ + ImageData
    Mid$(temp$, 1) = Chr$(Flag) 'replace our placeholder with the proper value of the custom flag
    compress$ = _Deflate$(temp$)
    f = FreeFile
    Open SaveFile For Output As #f: Close #f
    Open SaveFile For Binary As #f: Put #f, 1, compress$: Close #f
End Sub

The color picker 
Code: (Select All)
'colorpick16  0.2
'
'a color picker for mode 0 screens.
'compile as colorpick16.exe
'
Screen _NewImage(32, 8, 0)
_ScreenMove 600, 400
_Title "colorpick16"
blinkflag = -1
hflag = -1
FB = 0
BB = 0

print_picker FB, BB
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            If y >= 1 And y <= 2 Then
                fk = (y - 1) * 8 + Int(x / 4) + FB
            End If
            Color fk, 0
            If fk = 0 Then Color fk, 8
            _PrintString (12, 4), "    "
            _PrintString (12, 4), Str$(fk)
            If y = 7 Then
                bk = Int(x / 4) + BB
            End If
            Color fk, bk
            _PrintString (12, 5), "    "
            _PrintString (12, 5), Str$(bk)
            _Clipboard$ = "CK" + _Trim$(Str$(fk)) + "/" + _Trim$(Str$(bk))
            If x = 31 And y = 4 Then
                blinkflag = blinkflag * -1
                Select Case blinkflag
                    Case -1
                        FB = 0
                        BB = 0
                        print_picker FB, BB

                    Case 1
                        FB = 16
                        BB = 8
                        print_picker FB, BB

                End Select
            End If
        End If
    Loop
    kk$ = InKey$
    Select Case kk$
        Case "B"
            FB = 16
            BB = 8
            print_picker FB, BB
        Case "b"
            FB = 0
            BB = 0
            print_picker FB, BB
        Case Chr$(27)
            cc = _MessageBox("QUIT !", "Are you sure you wish to QUIT? The program will lose functionality. ", "yesnocancel", "warning", 0)
            If cc = 1 Then cc = 1 Else kk$ = ""
    End Select
    ccheck$ = _Clipboard$
    If ccheck$ = "QUITCOLORPICK16" Then kk$ = "QUITCOLORPICK16"
Loop Until kk$ = Chr$(27) Or kk$ = "QUITCOLORPICK16"
_Clipboard$ = "pickcolor quit"

System
Sub print_picker (f, b)
    For y = 0 To 1
        For x = 0 To 7
            fk = y * 8 + x + f
            p$ = "[  ]"
            a$ = _Trim$(Str$(fk))
            If Len(a$) = 1 Then
                Mid$(p$, 3, 1) = a$
            Else
                Mid$(p$, 2, 2) = a$
            End If
            Color fk, 0
            If fk = 0 Then Color 0, 7
            _PrintString ((x + 1) * 4 - 3, y + 1), p$
        Next
    Next
    _PrintString (31, 4), "B"
    _PrintString (1, 4), "Foreground"
    _PrintString (1, 5), "Background"
    For x = 0 To 7
        bk = x + b
        p$ = "[  ]"
        a$ = _Trim$(Str$(bk))
        If bk < 8 Then Mid$(p$, 3, 1) = a$ Else Mid$(p$, 2, 2) = a$
        Color 0, bk
        If bk = 0 Then Color 15, 0
        _PrintString ((x + 1) * 4 - 3, 7), p$
    Next
    fk = 15: bk = 0



End Sub


The ascii character picker.
Code: (Select All)
'colorpick16  0.2
'
'a color picker for mode 0 screens.
'compile as colorpick16.exe
'
Screen _NewImage(32, 8, 0)
_ScreenMove 600, 400
_Title "colorpick16"
blinkflag = -1
hflag = -1
FB = 0
BB = 0

print_picker FB, BB
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            If y >= 1 And y <= 2 Then
                fk = (y - 1) * 8 + Int(x / 4) + FB
            End If
            Color fk, 0
            If fk = 0 Then Color fk, 8
            _PrintString (12, 4), "    "
            _PrintString (12, 4), Str$(fk)
            If y = 7 Then
                bk = Int(x / 4) + BB
            End If
            Color fk, bk
            _PrintString (12, 5), "    "
            _PrintString (12, 5), Str$(bk)
            _Clipboard$ = "CK" + _Trim$(Str$(fk)) + "/" + _Trim$(Str$(bk))
            If x = 31 And y = 4 Then
                blinkflag = blinkflag * -1
                Select Case blinkflag
                    Case -1
                        FB = 0
                        BB = 0
                        print_picker FB, BB

                    Case 1
                        FB = 16
                        BB = 8
                        print_picker FB, BB

                End Select
            End If
        End If
    Loop
    kk$ = InKey$
    Select Case kk$
        Case "B"
            FB = 16
            BB = 8
            print_picker FB, BB
        Case "b"
            FB = 0
            BB = 0
            print_picker FB, BB
        Case Chr$(27)
            cc = _MessageBox("QUIT !", "Are you sure you wish to QUIT? The program will lose functionality. ", "yesnocancel", "warning", 0)
            If cc = 1 Then cc = 1 Else kk$ = ""
    End Select
    ccheck$ = _Clipboard$
    If ccheck$ = "QUITCOLORPICK16" Then kk$ = "QUITCOLORPICK16"
Loop Until kk$ = Chr$(27) Or kk$ = "QUITCOLORPICK16"
_Clipboard$ = "pickcolor quit"

System
Sub print_picker (f, b)
    For y = 0 To 1
        For x = 0 To 7
            fk = y * 8 + x + f
            p$ = "[  ]"
            a$ = _Trim$(Str$(fk))
            If Len(a$) = 1 Then
                Mid$(p$, 3, 1) = a$
            Else
                Mid$(p$, 2, 2) = a$
            End If
            Color fk, 0
            If fk = 0 Then Color 0, 7
            _PrintString ((x + 1) * 4 - 3, y + 1), p$
        Next
    Next
    _PrintString (31, 4), "B"
    _PrintString (1, 4), "Foreground"
    _PrintString (1, 5), "Background"
    For x = 0 To 7
        bk = x + b
        p$ = "[  ]"
        a$ = _Trim$(Str$(bk))
        If bk < 8 Then Mid$(p$, 3, 1) = a$ Else Mid$(p$, 2, 2) = a$
        Color 0, bk
        If bk = 0 Then Color 15, 0
        _PrintString ((x + 1) * 4 - 3, 7), p$
    Next
    fk = 15: bk = 0
End Sub
Reply
#2
Instead of sending text fragments to the clipboard, the fragments could be filenames that are created and could be checked with `_FILEEXISTS()`. But it could be better if somehow QB64 supported more than one `SCREEN` in a single program. Smile
Reply
#3
Ascii Clip V0.3

it doesn't use clipboard commands and instead reads and writes to a file all 3 apps read. Hopefully this will work on other platforms.

Code: (Select All)
'Ascii Clipdoodle  V 0.3
'an ascii doodle pad that opens control panel apps in other window
'
'
'loadtextimage and savetextimage from SMcNeil at  https://qb64phoenix.com/forum/showthread.php?tid=2022
'
'pickclip03.exe and colorpick1603.exe must be compiled before this program will function properly

Dim Shared reflag
reflag = -1
Dim Shared helpscreen As Long
Dim Shared twd, tht

twd = 80: tht = 25
helpscreen = _NewImage(twd, tht, 0)

Dim Shared mainscreen As Long
mainscreen = _NewImage(80, 25, 0) 'default size text screen. feel free to change it.
Screen mainscreen
_Title "Ascii ClipDoodle"
Cls
'open  cdoodle.tlk
write_msg "ClipDoodleOn"
Sleep 1
'_Clipboard$ = "ClipDoodleOn" ' "clears" clipboard for use
Shell _DontWait "pickclip03.exe" ' Open the pickclip control panel
Shell _DontWait "colorpick1603.exe" ' Open the colorpick16 control panel
_ControlChr Off
AK = 42
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        _Limit 2000
        x = _MouseX
        y = _MouseY
        px = _MouseX: py = _MouseY
        If _MouseButton(1) Then
            _PrintString (x, y), brush$
        End If
    Loop
    kk$ = InKey$
    Select Case kk$
        Case "t", "T" 'type on current line with current color characteristics
            _KeyClear
            Do
                Do
                    _Limit 60
                    tk$ = InKey$
                Loop Until tk$ <> ""
                If tk$ = Chr$(8) Then
                    tk$ = ""
                    px = px - 1
                End If
                If tk$ <> Chr$(13) And tk$ <> "" Then
                    _PrintString (px, py), tk$
                    px = px + 1
                    If px > _Width Then tk$ = Chr$(13) 'exit type input if attempting to type outside screen
                End If
            Loop Until tk$ = Chr$(13)
        Case "S" 'save text screen
            filef = 0
            file$ = _SaveFileDialog$("Save File", "", "*.SAV", "SAved text screen")
            If file$ <> "" Then
                filef = 1
                _MessageBox "Information", "File will be saved to " + file$
            End If
            If filef = 1 Then
                SaveTextImage 0, file$
                _MessageBox "Image SAved", "Text Images SAVED to " + file$
            End If
            filef = 0
        Case "L", "O" 'load text screen
            file$ = _OpenFileDialog$("Open File", "", "*.SAV", "SAVed text screen", -1)
            If file$ <> "" Then
                _MessageBox "Information", "You selected " + file$
                'mainscreen = LoadTextImage(file$)
                Screen LoadTextImage(file$)
                tht = _Height
                twid = _Width
            End If

        Case "C" 'clear screen
            cc = _MessageBox("CLEAR SCREEN", "Are you sure you want to clear the screen? The image will be lost if it has not been saved. ", "yesnocancel", "warning", 0)
            If cc = 1 Then Cls
        Case Chr$(27)
            cc = _MessageBox("QUIT !", "Are you sure you wish to QUIT? The image will be lost if it has not been saved. ", "yesnocancel", "warning", 0)
            If cc = 1 Then Else kk$ = ""

        Case "R"
            do_resize
        Case "?" 'help
            do_help
    End Select

    ik$ = get_msg$
    If Left$(ik$, 2) = "AC" Then AK = Val(Right$(ik$, Len(ik$) - 2))
    If Left$(ik$, 2) = "CK" Then
        ff$ = " "
        n = 2
        Do
            n = n + 1
            A$ = Mid$(ik$, n, 1)
            If A$ <> "/" Then ff$ = ff$ + A$
        Loop Until A$ = "/"
        bb$ = ""
        Do
            A$ = Mid$(ik$, n, 1)
            If A$ <> "/" Then bb$ = bb$ + A$
            n = n + 1
        Loop Until n > Len(ik$)
        FG = Val(ff$): BG = Val(bb$)
        Color FG, BG
    End If
    brush$ = Chr$(AK)
Loop Until kk$ = Chr$(27)
write_msg "QUITCOLORPICK16"
Sleep 1
write_msg "QUITCLIPPICK"
System
Sub do_help
    ls& = _Dest
    Screen helpscreen
    Cls
    Print "HELP"
    Print "------------------"
    Print "use mouse to draw with ascii characters"
    Print "select character to draw and colors from control panels"
    Print " "
    Print "<ESC> to quit program"
    Print "t,T  -  To type a line of text in colors picked"
    Print
    Print "S    - To Save Screen"
    Print "L,O  - to Load Saved Screen"
    Print "C    - to clear screen"
    Print
    Print "press any key to continue"
    Sleep
    Screen ls&
End Sub
Sub do_resize
    ls& = _Dest
    Screen helpscreen
    Cls
    Print "Resize"
    Print "------------------"
    Print "Current size "
    Print "width "; twd, "Height "; tht
    Print "Enter new coordinates"
    Input "Width "; twd
    Input "Height"; tht
    _FreeImage ls&

    Screen _NewImage(twd, tht, 0)
End Sub




Function LoadTextImage& (SaveFile As String) 'create and load to a new Screen 0 screen with our saved image
    Dim As Integer Wide, Tall, Flag: Wide = 80: Tall = 25: Flag = 0
    Dim As String ImageData
    Dim As _MEM M
    f = FreeFile
    Open SaveFile For Binary As #f
    compress$ = Space$(LOF(f))
    Get #f, 1, compress$
    Close #f
    temp$ = _Inflate$(compress$)
    Flag = Asc(temp$, 1): p = 2

    If Flag And 1 Then Wide = CVI(Mid$(temp$, p, 2)): p = p + 2
    If Flag And 2 Then Tall = CVI(Mid$(temp$, p, 2)): p = p + 2
    If Flag And 4 Then _Blink On Else _Blink Off
    If Flag And 8 Then _Font Asc(temp$, p): p = p + 1
    ImageData = Mid$(temp$, p)
    TempImage = _NewImage(Wide, Tall, 0)
    M = _MemImage(TempImage): _MemPut M, M.OFFSET, ImageData: _MemFree M
    LoadTextImage = TempImage
End Function

Sub SaveTextImage (ImageHandle As Long, SaveFile As String)
    Dim As Integer Wide, Tall, Flag
    Dim As Long ImageSize
    Dim As String ImageData
    Dim As _MEM M
    If _PixelSize(ImageHandle) <> 0 Then Error 5: Exit Sub 'only text images for this routine

    M = _MemImage(ImageHandle)
    Wide = _Width(ImageHandle): Tall = _Height(ImageHandle)
    temp$ = "0" 'placeholder for our finalized image flag which holds custom information

    If Wide <> 80 Then Flag = Flag + 1: temp$ = temp$ + MKI$(Wide)
    If Tall <> 25 Then Flag = Flag + 2: temp$ = temp$ + MKI$(Tall)
    If _Blink Then Flag = Flag + 4 'Set a flag saying that this image uses _Blink
    Select Case _Font(ImageHandle)
        Case 8: Flag = Flag + 8: temp$ = temp$ + Chr$(8)
        Case 9: Flag = Flag + 8: temp$ = temp$ + Chr$(9)
        Case 14: Flag = Flag + 8: temp$ = temp$ + Chr$(14)
        Case 15: Flag = Flag + 8: temp$ = temp$ + Chr$(15)
        Case 16 '16 needs no flag as it's the default for screen 0
        Case 17: Flag = Flag + 8: temp$ = temp$ + Chr$(17)
        Case Else
            'To be added once we get a _MemFont to retrieve custom font data back from QB64PE
    End Select
    ImageSize = Wide * Tall * 2
    ImageData = Space$(ImageSize): _MemGet M, M.OFFSET, ImageData: _MemFree M
    temp$ = temp$ + ImageData
    Mid$(temp$, 1) = Chr$(Flag) 'replace our placeholder with the proper value of the custom flag
    compress$ = _Deflate$(temp$)
    f = FreeFile
    Open SaveFile For Output As #f: Close #f
    Open SaveFile For Binary As #f: Put #f, 1, compress$: Close #f
End Sub

Sub write_msg (m$)
    Open "cdoodle.tlk" For Output As #11
    Print #11, m$
    Close #11
End Sub
Function get_msg$
    '-----------------------------------------------
    'get intraprogram messages
    '----------------------------------------------
    Open "cdoodle.tlk" For Input As #11
    Line Input #11, g$
    Close #11
    get_msg$ = g$
End Function

colorpick1603
Code: (Select All)
'colorpick16  0.3
'
'a color picker for mode 0 screens.
'compile as colorpick1603.exe
'
Screen _NewImage(32, 8, 0)
_ScreenMove 600, 400
_Title "colorpick16"
blinkflag = -1
hflag = -1
FB = 0
BB = 0

print_picker FB, BB
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            If y >= 1 And y <= 2 Then
                fk = (y - 1) * 8 + Int(x / 4) + FB
            End If
            Color fk, 0
            If fk = 0 Then Color fk, 8
            _PrintString (12, 4), "    "
            _PrintString (12, 4), Str$(fk)
            If y = 7 Then
                bk = Int(x / 4) + BB
            End If
            Color fk, bk
            _PrintString (12, 5), "    "
            _PrintString (12, 5), Str$(bk)
            ' _Clipboard$ = "CK" + _Trim$(Str$(fk)) + "/" + _Trim$(Str$(bk))
            cmsg$ = "CK" + _Trim$(Str$(fk)) + "/" + _Trim$(Str$(bk))
            write_msg cmsg$
            If x = 31 And y = 4 Then
                blinkflag = blinkflag * -1
                Select Case blinkflag
                    Case -1
                        FB = 0
                        BB = 0
                        print_picker FB, BB

                    Case 1
                        FB = 16
                        BB = 8
                        print_picker FB, BB

                End Select
            End If
        End If
    Loop
    kk$ = InKey$
    Select Case kk$
        Case "B"
            FB = 16
            BB = 8
            print_picker FB, BB
        Case "b"
            FB = 0
            BB = 0
            print_picker FB, BB
        Case Chr$(27)
            cc = _MessageBox("QUIT !", "Are you sure you wish to QUIT? The program will lose functionality. ", "yesnocancel", "warning", 0)
            If cc = 1 Then cc = 1 Else kk$ = ""
    End Select
    '  ccheck$ = _Clipboard$
    ccheck$ = get_msg$
    If ccheck$ = "QUITCOLORPICK16" Then kk$ = "QUITCOLORPICK16"
Loop Until kk$ = Chr$(27) Or kk$ = "QUITCOLORPICK16"
'_Clipboard$ = "pickcolor quit"
write_msg "pickcolor quit"

System
Sub print_picker (f, b)
    For y = 0 To 1
        For x = 0 To 7
            fk = y * 8 + x + f
            p$ = "[  ]"
            a$ = _Trim$(Str$(fk))
            If Len(a$) = 1 Then
                Mid$(p$, 3, 1) = a$
            Else
                Mid$(p$, 2, 2) = a$
            End If
            Color fk, 0
            If fk = 0 Then Color 0, 7
            _PrintString ((x + 1) * 4 - 3, y + 1), p$
        Next
    Next
    _PrintString (31, 4), "B"
    _PrintString (1, 4), "Foreground"
    _PrintString (1, 5), "Background"
    For x = 0 To 7
        bk = x + b
        p$ = "[  ]"
        a$ = _Trim$(Str$(bk))
        If bk < 8 Then Mid$(p$, 3, 1) = a$ Else Mid$(p$, 2, 2) = a$
        Color 0, bk
        If bk = 0 Then Color 15, 0
        _PrintString ((x + 1) * 4 - 3, 7), p$
    Next
    fk = 15: bk = 0
End Sub
Sub write_msg (m$)
    Open "cdoodle.tlk" For Output As #11
    Print #11, m$
    Close #11
End Sub
Function get_msg$
    '-----------------------------------------------
    'get intraprogram messages
    '----------------------------------------------
    Open "cdoodle.tlk" For Input As #11
    Line Input #11, g$
    Close #11
    get_msg$ = g$
End Function

pickclip03
Code: (Select All)
'pickclip  v0.3
'complie as pickclip03.exe
'sample of a "control panel" feeding output to the clipboard
Screen _NewImage(33, 20, 0)
_ScreenMove 600, 0
_Title "Pick Clip"
_ControlChr Off
AA = 0
'builds ascii grid
For y = 1 To 16
    For x = 1 To 16
        _PrintString (x * 2, y), Chr$(AA)
        AA = AA + 1
    Next
Next
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            x = Int(x / 2)
            AK = (y - 1) * 16 + (x - 1)
            _PrintString (1, 18), "                    "
            If AK > -1 And AK < 256 Then
                pp$ = "Picked ASCII " + Str$(AK) + " : " + Chr$(AK)
                _PrintString (1, 18), pp$
                '_Clipboard$ = "AC" + Str$(AK)
                cmsg$ = "AC" + Str$(AK)
                write_msg cmsg$

            End If
        End If
    Loop
    kk$ = InKey$
    cmsg$ = get_msg$
    ' If _Clipboard$ = "QUITCLIPPICK" Then kk$ = "QUITALL"
    If cmsg$ = "QUITCLIPPICK" Then kk$ = "QUITALL"

Loop Until kk$ = "QUITALL" Or kk$ = "Q"
'_Clipboard$ = "pickclip did quit" 'so QUIT message isn't left in clipboard
write_msg "pickclip did quit"
System
Sub write_msg (m$)
    Open "cdoodle.tlk" For Output As #11
    Print #11, m$
    Close #11
End Sub
Function get_msg$
    '-----------------------------------------------
    'get intraprogram messages
    '----------------------------------------------
    Open "cdoodle.tlk" For Input As #11
    Line Input #11, g$
    Close #11
    get_msg$ = g$
End Function
Reply
#4
Haha this is cool!

So how come you chose to put these in separate programs? Just curious Smile
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#5
(10-17-2023, 06:34 AM)grymmjack Wrote: Haha this is cool!

So how come you chose to put these in separate programs? Just curious Smile

An earlier version started as an experiment in multi-window programs. The user having control panels they can just move to where they like to fit their style and ease of use is also pretty handy and this is a pretty quick and easy way to do it. The user can also reset the size of the image they are drawing and this eliminates the need for dealing with dead space or trying to squeeze an image into a smaller space if the original program wasn't large enough, the other controls don't have to be resized or moved along with a change in the drawing size.
Reply
#6
JDJ this is an awesome program! A bit clumsy to navigate three windows.

For this to work on Linux, there are a few fixes to be made in order. It is recommendable to choose what the filenames will be for the executable files of the ASCII and color pickers. Cannot end in EXE, because Debian doesn't like it for some reason. I'm running this on Spiral Linux GNOME with Debian "Bookworm" base.

It is suggested to use `_CWD$()` to create a full path of the program the command shell is told to execute:

Code: (Select All)
thisdirectory$ = _CWD$ + "/"
Shell _DontWait thisdirectory$ + "jdjdoodleasciipick" ' Open the pickclip control panel
Shell _DontWait thisdirectory$ + "jdjdoodlecolorpick" ' Open the colorpick16 control panel

I revealed how I changed the filenames for the other two programs. Blush

I got an "Input Past End" runtime error for one of the pickers. It did not let me close the three programs together gracefully. It means must use `EOF()` everytime a line must be taken from an input file, in case that file is empty.

In line #54 of the ASCII picker:
Code: (Select All)
if not eof(11) then Line Input #11, g$

In line #116 of the color picker:
Code: (Select All)
if not eof(11) then Line Input #11, g$
Reply
#7
Quote:So how come you chose to put these in separate programs? Just curious Smile

The answer is obvious to me, he now has 3 independent programs that can be used in other apps, no need for libraries or copy/paste from a Toolbox of handy sub and function tools.

I started same with a GUI GetPathedFilename Dialog that prints selection to file and Clipboard.

That's one less direntry.h file I have to include in library or app, thats' one section I dont have to debug.

Big savings in time and redundant code is the short answer!

PLUS I can count on title working correctly as opposed to some other dialogues we've seen.

A piece at a time, independent of all other code, is a very clean uncluttered approach.
b = b + ...
Reply
#8
(10-17-2023, 05:19 PM)bplus Wrote:
Quote:So how come you chose to put these in separate programs? Just curious Smile

The answer is obvious to me, he now has 3 independent programs that can be used in other apps, no need for libraries or copy/paste from a Toolbox of handy sub and function tools.

I started same with a GUI GetPathedFilename Dialog that prints selection to file and Clipboard.

That's one less direntry.h file I have to include in library or app, thats' one section I dont have to debug.

Big savings in time and redundant code is the short answer!

PLUS I can count on title working correctly as opposed to some other dialogues we've seen.

A piece at a time, independent of all other code, is a very clean uncluttered approach.

All of those are excellent points.  I remember when they used to pretend, we'd have more ability to mix and match pieces of software from different vendors on the big OS's and that never really materialized as much as I'd have liked. Almost there... 30-35 years later and we'll stay at almost.
Reply
#9
(10-17-2023, 05:01 PM)mnrvovrfc Wrote: JDJ this is an awesome program! A bit clumsy to navigate three windows.

For this to work on Linux, there are a few fixes to be made in order. It is recommendable to choose what the filenames will be for the executable files of the ASCII and color pickers. Cannot end in EXE, because Debian doesn't like it for some reason. I'm running this on Spiral Linux GNOME with Debian "Bookworm" base.

It is suggested to use `_CWD$()` to create a full path of the program the command shell is told to execute:

Code: (Select All)
thisdirectory$ = _CWD$ + "/"
Shell _DontWait thisdirectory$ + "jdjdoodleasciipick" ' Open the pickclip control panel
Shell _DontWait thisdirectory$ + "jdjdoodlecolorpick" ' Open the colorpick16 control panel

I revealed how I changed the filenames for the other two programs.  Blush

I got an "Input Past End" runtime error for one of the pickers. It did not let me close the three programs together gracefully. It means must use `EOF()` everytime a line must be taken from an input file, in case that file is empty.

In line #54 of the ASCII picker:
Code: (Select All)
    if not eof(11) then Line Input #11, g$

In line #116 of the color picker:
Code: (Select All)
    if not eof(11) then Line Input #11, g$

Thanks for sharing the tips.  I haven't used a linux distribution in ages so I really don't know how it works these days. The EOF is odd for me as I've never noticed it being a problem with LINE INPUT in such a simple file. Thanks for pointing it out.
Reply
#10
Updated the apps for hopefully better file reading as per advice from mnrvovrfc above. Folks using a system other than windows may still have to edit their shell commands.

Added the ability to save as a jpeg image thanks to the QB64 PE 3.9 update.

[Image: image.png]


The mainprogram 
Code: (Select All)
'Ascii Clipdoodle  V 0.4
'an ascii doodle pad that opens control panel apps in other window
'
'
'loadtextimage and savetextimage from SMcNeil at  https://qb64phoenix.com/forum/showthread.php?tid=2022
'
'pickclip.exe and colorpick16.exe must be compiled before this program will function properly

Dim Shared reflag
reflag = -1
Dim Shared helpscreen As Long
Dim Shared twd, tht

twd = 80: tht = 25
helpscreen = _NewImage(twd, tht, 0)

Dim Shared mainscreen As Long
mainscreen = _NewImage(80, 25, 0) 'default size text screen. feel free to change it.
Screen mainscreen
_Title "Ascii ClipDoodle"
Cls
'open  cdoodle.tlk
write_msg "ClipDoodleOn"
Sleep 1
'_Clipboard$ = "ClipDoodleOn" ' "clears" clipboard for use
Shell _DontWait "pickclip04.exe" ' Open the pickclip control panel
Shell _DontWait "colorpick1604.exe" ' Open the colorpick16 control panel
_ControlChr Off
AK = 42
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        _Limit 2000
        x = _MouseX
        y = _MouseY
        px = _MouseX: py = _MouseY
        If _MouseButton(1) Then
            _PrintString (x, y), brush$
        End If
    Loop
    kk$ = InKey$
    Select Case kk$
        Case "t", "T" 'type on current line with current color characteristics
            _KeyClear
            Do
                Do
                    _Limit 60
                    tk$ = InKey$
                Loop Until tk$ <> ""
                If tk$ = Chr$(8) Then
                    tk$ = ""
                    px = px - 1
                End If
                If tk$ <> Chr$(13) And tk$ <> "" Then
                    _PrintString (px, py), tk$
                    px = px + 1
                    If px > _Width Then tk$ = Chr$(13) 'exit type input if attempting to type outside screen
                End If
            Loop Until tk$ = Chr$(13)
        Case "S" 'save text screen
            filef = 0
            file$ = _SaveFileDialog$("Save File", "", "*.SAV", "SAved text screen")
            If file$ <> "" Then
                filef = 1
                _MessageBox "Information", "File will be saved to " + file$
            End If
            If filef = 1 Then
                SaveTextImage 0, file$
                _MessageBox "Image SAved", "Text Images SAVED to " + file$
            End If
            filef = 0
        Case "L", "O" 'load text screen
            file$ = _OpenFileDialog$("Open File", "", "*.SAV", "SAVed text screen", -1)
            If file$ <> "" Then
                _MessageBox "Information", "You selected " + file$
                'mainscreen = LoadTextImage(file$)
                Screen LoadTextImage(file$)
                tht = _Height
                twid = _Width
            End If

        Case "C" 'clear screen
            cc = _MessageBox("CLEAR SCREEN", "Are you sure you want to clear the screen? The image will be lost if it has not been saved. ", "yesnocancel", "warning", 0)
            If cc = 1 Then Cls
        Case Chr$(27)
            cc = _MessageBox("QUIT !", "Are you sure you wish to QUIT? The image will be lost if it has not been saved. ", "yesnocancel", "warning", 0)
            If cc = 1 Then Else kk$ = ""

        Case "J" 'save as jpeg
            filef = 0
            file$ = _SaveFileDialog$("Save File", "", "*.JPG", "JPEG Image")
            If file$ <> "" Then
                filef = 1
                _MessageBox "Information", "File will be saved to " + file$
            End If
            If filef = 1 Then
                _SaveImage file$, 0, "JPG"

                _MessageBox "JPEG SAved", "Text Images SAVED to " + file$
            End If
            filef = 0



        Case "R"
            do_resize
        Case "?" 'help
            do_help
    End Select

    ik$ = get_msg$
    If Left$(ik$, 2) = "AC" Then AK = Val(Right$(ik$, Len(ik$) - 2))
    If Left$(ik$, 2) = "CK" Then
        ff$ = " "
        n = 2
        Do
            n = n + 1
            A$ = Mid$(ik$, n, 1)
            If A$ <> "/" Then ff$ = ff$ + A$
        Loop Until A$ = "/"
        bb$ = ""
        Do
            A$ = Mid$(ik$, n, 1)
            If A$ <> "/" Then bb$ = bb$ + A$
            n = n + 1
        Loop Until n > Len(ik$)
        FG = Val(ff$): BG = Val(bb$)
        Color FG, BG
    End If
    brush$ = Chr$(AK)
Loop Until kk$ = Chr$(27)
write_msg "QUITCOLORPICK16"
Sleep 1
write_msg "QUITCLIPPICK"
System
Sub do_help
    ls& = _Dest
    Screen helpscreen
    Cls
    Print "HELP"
    Print "------------------"
    Print "use mouse to draw with ascii characters"
    Print "select character to draw and colors from control panels"
    Print " "
    Print "<ESC> to quit program"
    Print "t,T  -  To type a line of text in colors picked"
    Print
    Print "S    - To Save Screen"
    Print "L,O  - to Load Saved Screen"
    Print "J      -save as jpeg file."
    Print "C    - to clear screen"
    Print
    Print "press any key to continue"
    Sleep
    Screen ls&
End Sub
Sub do_resize
    ls& = _Dest
    Screen helpscreen
    Cls
    Print "Resize"
    Print "------------------"
    Print "Current size "
    Print "width "; twd, "Height "; tht
    Print "Enter new coordinates"
    Input "Width "; twd
    Input "Height"; tht
    _FreeImage ls&

    Screen _NewImage(twd, tht, 0)
End Sub




Function LoadTextImage& (SaveFile As String) 'create and load to a new Screen 0 screen with our saved image
    Dim As Integer Wide, Tall, Flag: Wide = 80: Tall = 25: Flag = 0
    Dim As String ImageData
    Dim As _MEM M
    f = FreeFile
    Open SaveFile For Binary As #f
    compress$ = Space$(LOF(f))
    Get #f, 1, compress$
    Close #f
    temp$ = _Inflate$(compress$)
    Flag = Asc(temp$, 1): p = 2

    If Flag And 1 Then Wide = CVI(Mid$(temp$, p, 2)): p = p + 2
    If Flag And 2 Then Tall = CVI(Mid$(temp$, p, 2)): p = p + 2
    If Flag And 4 Then _Blink On Else _Blink Off
    If Flag And 8 Then _Font Asc(temp$, p): p = p + 1
    ImageData = Mid$(temp$, p)
    TempImage = _NewImage(Wide, Tall, 0)
    M = _MemImage(TempImage): _MemPut M, M.OFFSET, ImageData: _MemFree M
    LoadTextImage = TempImage
End Function

Sub SaveTextImage (ImageHandle As Long, SaveFile As String)
    Dim As Integer Wide, Tall, Flag
    Dim As Long ImageSize
    Dim As String ImageData
    Dim As _MEM M
    If _PixelSize(ImageHandle) <> 0 Then Error 5: Exit Sub 'only text images for this routine

    M = _MemImage(ImageHandle)
    Wide = _Width(ImageHandle): Tall = _Height(ImageHandle)
    temp$ = "0" 'placeholder for our finalized image flag which holds custom information

    If Wide <> 80 Then Flag = Flag + 1: temp$ = temp$ + MKI$(Wide)
    If Tall <> 25 Then Flag = Flag + 2: temp$ = temp$ + MKI$(Tall)
    If _Blink Then Flag = Flag + 4 'Set a flag saying that this image uses _Blink
    Select Case _Font(ImageHandle)
        Case 8: Flag = Flag + 8: temp$ = temp$ + Chr$(8)
        Case 9: Flag = Flag + 8: temp$ = temp$ + Chr$(9)
        Case 14: Flag = Flag + 8: temp$ = temp$ + Chr$(14)
        Case 15: Flag = Flag + 8: temp$ = temp$ + Chr$(15)
        Case 16 '16 needs no flag as it's the default for screen 0
        Case 17: Flag = Flag + 8: temp$ = temp$ + Chr$(17)
        Case Else
            'To be added once we get a _MemFont to retrieve custom font data back from QB64PE
    End Select
    ImageSize = Wide * Tall * 2
    ImageData = Space$(ImageSize): _MemGet M, M.OFFSET, ImageData: _MemFree M
    temp$ = temp$ + ImageData
    Mid$(temp$, 1) = Chr$(Flag) 'replace our placeholder with the proper value of the custom flag
    compress$ = _Deflate$(temp$)
    f = FreeFile
    Open SaveFile For Output As #f: Close #f
    Open SaveFile For Binary As #f: Put #f, 1, compress$: Close #f
End Sub

Sub write_msg (m$)
    Open "cdoodle.tlk" For Output As #11
    Print #11, m$
    Close #11
End Sub
Function get_msg$
    '-----------------------------------------------
    'get intraprogram messages
    '----------------------------------------------
    Open "cdoodle.tlk" For Input As #11
    ' Line Input #11, g$
    If Not EOF(11) Then Line Input #11, g$
    Close #11
    get_msg$ = g$
End Function

the color picker control
Code: (Select All)
'colorpick16  0.4
'
'a color picker for mode 0 screens.
'compile as colorpick1604.exe  or anythign else of course just make sure to use the same name in the main program
'
Screen _NewImage(32, 8, 0)
_ScreenMove 600, 400
_Title "colorpick16"
blinkflag = -1
hflag = -1
FB = 0
BB = 0

print_picker FB, BB
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            If y >= 1 And y <= 2 Then
                fk = (y - 1) * 8 + Int(x / 4) + FB
            End If
            Color fk, 0
            If fk = 0 Then Color fk, 8
            _PrintString (12, 4), "    "
            _PrintString (12, 4), Str$(fk)
            If y = 7 Then
                bk = Int(x / 4) + BB
            End If
            Color fk, bk
            _PrintString (12, 5), "    "
            _PrintString (12, 5), Str$(bk)
            ' _Clipboard$ = "CK" + _Trim$(Str$(fk)) + "/" + _Trim$(Str$(bk))
            cmsg$ = "CK" + _Trim$(Str$(fk)) + "/" + _Trim$(Str$(bk))
            write_msg cmsg$
            If x = 31 And y = 4 Then
                blinkflag = blinkflag * -1
                Select Case blinkflag
                    Case -1
                        FB = 0
                        BB = 0
                        print_picker FB, BB

                    Case 1
                        FB = 16
                        BB = 8
                        print_picker FB, BB

                End Select
            End If
        End If
    Loop
    kk$ = InKey$
    Select Case kk$
        Case "B"
            FB = 16
            BB = 8
            print_picker FB, BB
        Case "b"
            FB = 0
            BB = 0
            print_picker FB, BB
        Case Chr$(27)
            cc = _MessageBox("QUIT !", "Are you sure you wish to QUIT? The program will lose functionality. ", "yesnocancel", "warning", 0)
            If cc = 1 Then cc = 1 Else kk$ = ""
    End Select
    '  ccheck$ = _Clipboard$
    ccheck$ = get_msg$
    If ccheck$ = "QUITCOLORPICK16" Then kk$ = "QUITCOLORPICK16"
Loop Until kk$ = Chr$(27) Or kk$ = "QUITCOLORPICK16"
'_Clipboard$ = "pickcolor quit"
write_msg "pickcolor quit"

System
Sub print_picker (f, b)
    For y = 0 To 1
        For x = 0 To 7
            fk = y * 8 + x + f
            p$ = "[  ]"
            a$ = _Trim$(Str$(fk))
            If Len(a$) = 1 Then
                Mid$(p$, 3, 1) = a$
            Else
                Mid$(p$, 2, 2) = a$
            End If
            Color fk, 0
            If fk = 0 Then Color 0, 7
            _PrintString ((x + 1) * 4 - 3, y + 1), p$
        Next
    Next
    _PrintString (31, 4), "B"
    _PrintString (1, 4), "Foreground"
    _PrintString (1, 5), "Background"
    For x = 0 To 7
        bk = x + b
        p$ = "[  ]"
        a$ = _Trim$(Str$(bk))
        If bk < 8 Then Mid$(p$, 3, 1) = a$ Else Mid$(p$, 2, 2) = a$
        Color 0, bk
        If bk = 0 Then Color 15, 0
        _PrintString ((x + 1) * 4 - 3, 7), p$
    Next
    fk = 15: bk = 0
End Sub
Sub write_msg (m$)
    Open "cdoodle.tlk" For Output As #11
    Print #11, m$
    Close #11
End Sub
Function get_msg$
    '-----------------------------------------------
    'get intraprogram messages
    '----------------------------------------------
    Open "cdoodle.tlk" For Input As #11
    ' Line Input #11, g$
    If Not EOF(11) Then Line Input #11, g$
    Close #11
    get_msg$ = g$
End Function

the character picker for the "paintbrush"
Code: (Select All)
'pickclip  v0.4
'complie as pickclip04.exe  or whatever you wish to call it in your main program
'sample of a "control panel" feeding output to the clipboard
Screen _NewImage(33, 20, 0)
_ScreenMove 600, 0
_Title "Pick Clip"
_ControlChr Off
AA = 0
'builds ascii grid
For y = 1 To 16
    For x = 1 To 16
        _PrintString (x * 2, y), Chr$(AA)
        AA = AA + 1
    Next
Next
Do
    _Limit 100
    Do While _MouseInput 'mouse status changes only
        x = _MouseX
        y = _MouseY
        If _MouseButton(1) Then
            x = Int(x / 2)
            AK = (y - 1) * 16 + (x - 1)
            _PrintString (1, 18), "                    "
            If AK > -1 And AK < 256 Then
                pp$ = "Picked ASCII " + Str$(AK) + " : " + Chr$(AK)
                _PrintString (1, 18), pp$
                '_Clipboard$ = "AC" + Str$(AK)
                cmsg$ = "AC" + Str$(AK)
                write_msg cmsg$

            End If
        End If
    Loop
    kk$ = InKey$
    cmsg$ = get_msg$
    ' If _Clipboard$ = "QUITCLIPPICK" Then kk$ = "QUITALL"
    If cmsg$ = "QUITCLIPPICK" Then kk$ = "QUITALL"

Loop Until kk$ = "QUITALL" Or kk$ = "Q"
'_Clipboard$ = "pickclip did quit" 'so QUIT message isn't left in clipboard
write_msg "pickclip did quit"
System
Sub write_msg (m$)
    Open "cdoodle.tlk" For Output As #11
    Print #11, m$
    Close #11
End Sub
Function get_msg$
    '-----------------------------------------------
    'get intraprogram messages
    '----------------------------------------------
    Open "cdoodle.tlk" For Input As #11
    ' Line Input #11, g$
    If Not EOF(11) Then Line Input #11, g$
    Close #11
    get_msg$ = g$
End Function
Reply




Users browsing this thread: 19 Guest(s)