VERSION DVX 1.00
Begin Form IconEd
    Caption   = "DVX Icon Editor"
    Layout    = VBox
    AutoSize  = True
    Resizable = False
    Centered  = True

    Begin Menu mnuFile
        Caption = "&File"
        Begin Menu mnuNew
            Caption = "&New"
        End
        Begin Menu mnuOpen
            Caption = "&Open..."
        End
        Begin Menu mnuSave
            Caption = "&Save..."
        End
        Begin Menu mnuPrint
            Caption = "&Print..."
        End
        Begin Menu mnuSep1
            Caption = "-"
        End
        Begin Menu mnuExit
            Caption = "E&xit"
        End
    End

    Begin Menu mnuTools
        Caption = "&Tools"
        Begin Menu mnuPencil
            Caption = "&Pencil"
            Checked = True
            RadioCheck = True
        End
        Begin Menu mnuEraser
            Caption = "&Eraser"
            RadioCheck = True
        End
        Begin Menu mnuPicker
            Caption = "Color Pic&ker"
            RadioCheck = True
        End
    End

    Begin Menu mnuSize
        Caption = "&Size"
        Begin Menu mnuSize16
            Caption = "16 x 16"
            RadioCheck = True
        End
        Begin Menu mnuSize24
            Caption = "24 x 24"
            RadioCheck = True
        End
        Begin Menu mnuSize32
            Caption = "32 x 32"
            Checked = True
            RadioCheck = True
        End
    End
    Begin Menu mnuHelp
        Caption = "&Help"
        Begin Menu mnuHelpContents
            Caption = "&Contents"
        End
        Begin Menu mnuHelpSep
            Caption = "-"
        End
        Begin Menu mnuAbout
            Caption = "&About Icon Editor..."
        End
    End

    Begin Frame fraMain
        Caption = ""
        Layout  = HBox
        Weight  = 100

        Begin PictureBox cvEditor
            Width   = 256
            Height  = 256
            Weight  = 0
        End

        Begin Frame fraSidebar
            Caption = ""
            Layout  = VBox
            Width   = 100
            Weight  = 0

            Begin Label lblPreview
                Caption = "Preview:"
            End

            Begin PictureBox cvPreview
                Width   = 32
                Height  = 32
                Weight  = 0
            End

            Begin Label lblColor
                Caption = "Color:"
            End

            Begin PictureBox cvSelColor
                Width   = 32
                Height  = 20
                Weight  = 0
            End

            Begin Label lblPalette
                Caption = "Palette:"
            End

            Begin PictureBox cvPalette
                Width   = 80
                Height  = 80
                Weight  = 0
            End
        End
    End

    Begin Label lblStatus
        Caption = "Ready. (0, 0)"
        Height  = 16
        Weight  = 0
    End
End

' The MIT License (MIT)
'
' Copyright (C) 2026 Scott Duensing
'
' Permission is hereby granted, free of charge, to any person obtaining a copy
' of this software and associated documentation files (the "Software"), to
' deal in the Software without restriction, including without limitation the
' rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
' sell copies of the Software, and to permit persons to whom the Software is
' furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in
' all copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
' FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
' IN THE SOFTWARE.


OPTION EXPLICIT


' Pixels are held in pixels() at their exact RGB values. The preview
' canvas (used for Load and Save) stores the display's pixel format, so
' in 15/16-bit and 256-color display modes colors are rounded to what the
' display can show when an icon is opened or saved.

CONST CANVAS_SIZE = 256
CONST BG_COLOR    = &H00C0C0C0
CONST GRID_COLOR  = &H00808080
CONST EDGE_COLOR  = &H00404040
CONST TOOL_PENCIL = 0
CONST TOOL_ERASER = 1
CONST TOOL_PICKER = 2
CONST PAL_COLS    = 8
CONST PAL_ROWS    = 4
CONST PAL_COUNT   = 32          ' PAL_COLS * PAL_ROWS (CONST takes only literals)
CONST PAL_CELL    = 10
CONST SIZE_SMALL  = 16
CONST SIZE_MEDIUM = 24
CONST MAX_ICON    = 32
CONST HELP_FILE   = "iconed.hlp"
CONST OPEN_FILTER = "Icon Images (*.bmp;*.png)|All Files (*.*)"
CONST SAVE_FILTER = "PNG Images (*.png)|All Files (*.*)"

DIM SHARED pixels(MAX_ICON - 1, MAX_ICON - 1) AS LONG
DIM SHARED palette(PAL_COUNT - 1) AS LONG
DIM SHARED iconW AS INTEGER
DIM SHARED iconH AS INTEGER
DIM SHARED pixelSize AS INTEGER
DIM SHARED curTool AS INTEGER
DIM SHARED curColor AS LONG
DIM SHARED drawing AS BOOLEAN
DIM SHARED dirty AS BOOLEAN
DIM SHARED filePath AS STRING


SUB InitPalette
    palette(0)  = &H00000000
    palette(1)  = &H00FFFFFF
    palette(2)  = &H00C0C0C0
    palette(3)  = &H00808080
    palette(4)  = &H000000FF
    palette(5)  = &H00000080
    palette(6)  = &H000080FF
    palette(7)  = &H00004080
    palette(8)  = &H0000FFFF
    palette(9)  = &H00008080
    palette(10) = &H0000FF00
    palette(11) = &H00008000
    palette(12) = &H00FFFF00
    palette(13) = &H00808000
    palette(14) = &H0080FF00
    palette(15) = &H00404000
    palette(16) = &H00FF0000
    palette(17) = &H00800000
    palette(18) = &H00FF0080
    palette(19) = &H00800080
    palette(20) = &H00FF00FF
    palette(21) = &H008000FF
    palette(22) = &H00C080FF
    palette(23) = &H00FF4040
    palette(24) = &H00404040
    palette(25) = &H00A0A0A0
    palette(26) = &H00E0E0E0
    palette(27) = &H00C0E0FF
    palette(28) = &H00E0FFC0
    palette(29) = &H00FFE0C0
    palette(30) = &H00C0C0FF
    palette(31) = &H00FFC0C0
END SUB


SUB ClearPixels
    DIM x AS INTEGER
    DIM y AS INTEGER
    FOR y = 0 TO MAX_ICON - 1
        FOR x = 0 TO MAX_ICON - 1
            pixels(x, y) = BG_COLOR
        NEXT x
    NEXT y
    dirty = False
END SUB


' The preview canvas always matches the icon size, so Save writes exactly
' iconW x iconH pixels.
SUB SetIconSize(w AS INTEGER)
    iconW     = w
    iconH     = w
    pixelSize = CANVAS_SIZE \ w
    cvPreview.Resize w, w
END SUB


' Checks the Size menu item for the current icon size.
SUB CheckSizeMenu
    IF iconW = SIZE_SMALL THEN
        mnuSize16.Checked = True
    ELSEIF iconW = SIZE_MEDIUM THEN
        mnuSize24.Checked = True
    ELSE
        mnuSize32.Checked = True
    END IF
END SUB


FUNCTION IsIconSize(w AS INTEGER) AS BOOLEAN
    IsIconSize = (w = SIZE_SMALL OR w = SIZE_MEDIUM OR w = MAX_ICON)
END FUNCTION


SUB DrawEditorGrid
    DIM x AS INTEGER
    DIM y AS INTEGER
    DIM edgeW AS INTEGER
    cvEditor.Clear BG_COLOR
    FOR y = 0 TO iconH - 1
        FOR x = 0 TO iconW - 1
            cvEditor.FillRect x * pixelSize, y * pixelSize, pixelSize, pixelSize, pixels(x, y)
        NEXT x
    NEXT y
    FOR x = 0 TO iconW
        cvEditor.DrawLine x * pixelSize, 0, x * pixelSize, iconH * pixelSize, GRID_COLOR
    NEXT x
    FOR y = 0 TO iconH
        cvEditor.DrawLine 0, y * pixelSize, iconW * pixelSize, y * pixelSize, GRID_COLOR
    NEXT y
    edgeW = iconW * pixelSize
    cvEditor.DrawRect 0, 0, edgeW, edgeW, EDGE_COLOR
    cvEditor.Refresh
END SUB


SUB DrawPreview
    DIM x AS INTEGER
    DIM y AS INTEGER
    FOR y = 0 TO iconH - 1
        FOR x = 0 TO iconW - 1
            cvPreview.SetPixel x, y, pixels(x, y)
        NEXT x
    NEXT y
    cvPreview.Refresh
END SUB


SUB DrawPalette
    DIM i AS INTEGER
    DIM px AS INTEGER
    DIM py AS INTEGER
    cvPalette.Clear BG_COLOR
    FOR i = 0 TO PAL_COUNT - 1
        px = (i MOD PAL_COLS) * PAL_CELL
        py = (i \ PAL_COLS) * PAL_CELL
        cvPalette.FillRect px, py, PAL_CELL, PAL_CELL, palette(i)
        cvPalette.DrawRect px, py, PAL_CELL, PAL_CELL, &H00000000
    NEXT i
    cvPalette.Refresh
END SUB


SUB DrawSelectedColor
    cvSelColor.Clear curColor
    cvSelColor.Refresh
END SUB


SUB RefreshAll
    DrawEditorGrid
    DrawPreview
    DrawSelectedColor
END SUB


SUB UpdateTitle
    DIM t AS STRING
    t = "DVX Icon Editor - " + LTRIM$(STR$(iconW)) + "x" + LTRIM$(STR$(iconH))
    IF filePath <> "" THEN
        t = t + " - " + filePath
    END IF
    IF dirty THEN
        t = t + " *"
    END IF
    IconEd.Caption = t
END SUB


SUB SetIconPixel(x AS INTEGER, y AS INTEGER)
    DIM c AS LONG
    IF x < 0 OR x >= iconW OR y < 0 OR y >= iconH THEN
        EXIT SUB
    END IF
    IF curTool = TOOL_ERASER THEN
        c = BG_COLOR
    ELSE
        c = curColor
    END IF
    IF pixels(x, y) <> c THEN
        pixels(x, y) = c
        ' The caption only changes on the clean-to-dirty transition.
        IF NOT dirty THEN
            dirty = True
            UpdateTitle
        END IF
        cvEditor.FillRect x * pixelSize, y * pixelSize, pixelSize, pixelSize, c
        cvEditor.DrawLine x * pixelSize, y * pixelSize, (x + 1) * pixelSize, y * pixelSize, GRID_COLOR
        cvEditor.DrawLine x * pixelSize, y * pixelSize, x * pixelSize, (y + 1) * pixelSize, GRID_COLOR
        cvEditor.DrawLine (x + 1) * pixelSize, y * pixelSize, (x + 1) * pixelSize, (y + 1) * pixelSize, GRID_COLOR
        cvEditor.DrawLine x * pixelSize, (y + 1) * pixelSize, (x + 1) * pixelSize, (y + 1) * pixelSize, GRID_COLOR
        cvPreview.SetPixel x, y, c
    END IF
END SUB


SUB SelectTool(t AS INTEGER)
    curTool = t
    IF t = TOOL_PENCIL THEN
        mnuPencil.Checked = True
        lblStatus.Caption = "Tool: Pencil"
    ELSEIF t = TOOL_ERASER THEN
        mnuEraser.Checked = True
        lblStatus.Caption = "Tool: Eraser"
    ELSEIF t = TOOL_PICKER THEN
        mnuPicker.Checked = True
        lblStatus.Caption = "Tool: Picker"
    END IF
END SUB


SUB ChangeSize(newSize AS INTEGER)
    DIM ans AS INTEGER
    IF newSize = iconW THEN
        EXIT SUB
    END IF
    IF dirty THEN
        ans = MsgBox("Unsaved changes will be lost. Change size?", vbYesNo)
        IF ans = vbNo THEN
            ' The menu already moved the radio check; put it back.
            CheckSizeMenu
            EXIT SUB
        END IF
    END IF
    SetIconSize newSize
    ClearPixels
    filePath = ""
    CheckSizeMenu
    UpdateTitle
    RefreshAll
    lblStatus.Caption = STR$(iconW) + "x" + STR$(iconH) + " - Ready."
END SUB


' Writes the preview canvas to path. Returns False when the file could
' not be written.
FUNCTION SaveIcon(path AS STRING) AS BOOLEAN
    DrawPreview
    SaveIcon = (cvPreview.Save(path) = 0)
END FUNCTION


SUB IconEd_Load
    InitPalette
    SetIconSize MAX_ICON
    ClearPixels
    curTool  = TOOL_PENCIL
    curColor = &H00000000
    drawing  = False
    filePath = ""
    DrawPalette
    RefreshAll
    UpdateTitle
    ' An icon named on the command line (a document opened from Program
    ' Manager or File Manager) is loaded at once.
    IF COMMAND$(1) <> "" THEN
        OpenIcon COMMAND$(1)
    END IF
END SUB


SUB mnuNew_Click
    DIM ans AS INTEGER
    IF dirty THEN
        ans = MsgBox("Unsaved changes. Start new icon?", vbYesNo)
        IF ans = vbNo THEN
            EXIT SUB
        END IF
    END IF
    ClearPixels
    filePath = ""
    UpdateTitle
    RefreshAll
END SUB


SUB mnuOpen_Click
    DIM ans AS INTEGER
    DIM path AS STRING
    IF dirty THEN
        ans = MsgBox("Unsaved changes. Open another file?", vbYesNo)
        IF ans = vbNo THEN
            EXIT SUB
        END IF
    END IF
    path = DlgFileOpen$("Open Icon", OPEN_FILTER)
    IF path = "" THEN
        EXIT SUB
    END IF
    OpenIcon path
END SUB


' Loads the icon in path; a file that is not a 16, 24 or 32 pixel square
' image is refused (reported) and the current icon stays.
SUB OpenIcon(path AS STRING)
    DIM w AS INTEGER
    DIM x AS INTEGER
    DIM y AS INTEGER
    ' A failed Load leaves the preview unchanged; a successful one gives
    ' it the image's size.
    IF cvPreview.Load(path) <> 0 THEN
        MsgBox "Could not load " + path + "."
        EXIT SUB
    END IF
    w = cvPreview.ImageWidth
    IF cvPreview.ImageHeight <> w OR NOT IsIconSize(w) THEN
        ' Put the current icon back into the preview.
        cvPreview.Resize iconW, iconH
        DrawPreview
        MsgBox "Icons must be 16 x 16, 24 x 24, or 32 x 32 pixels."
        EXIT SUB
    END IF
    SetIconSize w
    ClearPixels
    FOR y = 0 TO iconH - 1
        FOR x = 0 TO iconW - 1
            pixels(x, y) = cvPreview.GetPixel(x, y)
        NEXT x
    NEXT y
    filePath = path
    CheckSizeMenu
    UpdateTitle
    RefreshAll
END SUB


SUB mnuSave_Click
    DIM path AS STRING
    path = DlgFileSave$("Save Icon", SAVE_FILTER)
    IF path = "" THEN
        EXIT SUB
    END IF
    IF NOT SaveIcon(path) THEN
        MsgBox "Could not save " + path + "."
        EXIT SUB
    END IF
    filePath = path
    dirty    = False
    UpdateTitle
    lblStatus.Caption = "Saved: " + path
END SUB


' The printing library prints picture files, so the icon goes through a
' scratch copy in the TEMP folder (else the program's user folder).
SUB mnuPrint_Click
    DIM tmp AS STRING
    DIM title AS STRING
    tmp = FileOpsTempDir$()
    IF tmp = "" THEN
        tmp = App.User
    END IF
    tmp = FileOpsPathJoin$(tmp, "PRINTICO.BMP")
    IF NOT SaveIcon(tmp) THEN
        MsgBox "Could not prepare the icon for printing."
        EXIT SUB
    END IF
    IF filePath <> "" THEN
        title = filePath
    ELSE
        title = "Untitled icon"
    END IF
    PrintPictureDialog tmp, title
    KILL tmp
END SUB


SUB mnuExit_Click
    Unload IconEd
END SUB


SUB mnuPencil_Click
    SelectTool TOOL_PENCIL
END SUB


SUB mnuEraser_Click
    SelectTool TOOL_ERASER
END SUB


SUB mnuPicker_Click
    SelectTool TOOL_PICKER
END SUB


SUB mnuSize16_Click
    ChangeSize SIZE_SMALL
END SUB


SUB mnuSize24_Click
    ChangeSize SIZE_MEDIUM
END SUB


SUB mnuSize32_Click
    ChangeSize MAX_ICON
END SUB


SUB cvEditor_MouseDown(button AS INTEGER, x AS INTEGER, y AS INTEGER)
    DIM px AS INTEGER
    DIM py AS INTEGER
    px = x \ pixelSize
    py = y \ pixelSize
    IF curTool = TOOL_PICKER THEN
        IF px >= 0 AND px < iconW AND py >= 0 AND py < iconH THEN
            curColor = pixels(px, py)
            DrawSelectedColor
            SelectTool TOOL_PENCIL
        END IF
        EXIT SUB
    END IF
    drawing = True
    SetIconPixel px, py
    lblStatus.Caption = "(" + STR$(px) + "," + STR$(py) + ")"
END SUB


SUB cvEditor_MouseMove(button AS INTEGER, x AS INTEGER, y AS INTEGER)
    DIM px AS INTEGER
    DIM py AS INTEGER
    px = x \ pixelSize
    py = y \ pixelSize
    IF px >= 0 AND px < iconW AND py >= 0 AND py < iconH THEN
        lblStatus.Caption = "(" + STR$(px) + "," + STR$(py) + ")"
    END IF
    IF drawing THEN
        SetIconPixel px, py
    END IF
END SUB


SUB cvEditor_MouseUp(button AS INTEGER, x AS INTEGER, y AS INTEGER)
    drawing = False
END SUB


SUB IconEd_QueryUnload(Cancel AS INTEGER)
    IF NOT dirty THEN
        EXIT SUB
    END IF
    DIM result AS INTEGER
    result = DlgPromptSave("Icon Editor")
    IF result = DVX_SAVE_YES THEN
        mnuSave_Click
        IF dirty THEN
            Cancel = 1
        END IF
    ELSEIF result = DVX_SAVE_CANCEL THEN
        Cancel = 1
    END IF
END SUB


SUB cvPalette_MouseDown(button AS INTEGER, x AS INTEGER, y AS INTEGER)
    DIM col AS INTEGER
    DIM row AS INTEGER
    DIM idx AS INTEGER
    col = x \ PAL_CELL
    row = y \ PAL_CELL
    IF col >= 0 AND col < PAL_COLS AND row >= 0 AND row < PAL_ROWS THEN
        idx = row * PAL_COLS + col
        curColor = palette(idx)
        DrawSelectedColor
        IF curTool = TOOL_PICKER THEN
            SelectTool TOOL_PENCIL
        END IF
    END IF
END SUB


SUB mnuHelpContents_Click
    HelpView HELP_FILE
END SUB


SUB mnuAbout_Click
    DIM msg AS STRING
    msg = "Icon Editor" + CHR$(10) + CHR$(10)
    msg = msg + "Draws small square pictures and icons." + CHR$(10) + CHR$(10)
    msg = msg + "Copyright 2026 Scott Duensing"
    MsgBox msg, vbOKOnly + vbInformation, "About Icon Editor"
END SUB