Vince's Corner Takeout

[vince]

Vince Text Editor

New mod inspired by B+'s new GUI. This is a demonstration of using _MEM, _MEMNEW, and _MEMPUT to create dynamically allocated doubly linked lists like you would in C (with malloc and pointers) featured as a library in subs addNodeNext, addNodePrev, rmNode, nextNode, prevNode, lenNode, readNode, writeNode, newList, printList, rmList.  The demo features keyboard editable scrollable textboxes in draggable resizeable windows using TWM style resizing mechanism.  The black screen is a demo of a command line. Special thanks to keybone for modding sub drawWin to look more like BeOS

Code: (Select All)

DEFINT A-Z

CONST sw = 800
CONST sh = 600

CONST winBarH = 25
CONST winMinW = 50
CONST winMinH = 50

CONST fontSize = 16

TYPE nodeType
    str AS _MEM
    strLen AS INTEGER

    n AS _MEM
    p AS _MEM
END TYPE

TYPE listType
    head AS _MEM
    tail AS _MEM

    cur AS _MEM

    cx AS INTEGER
    cy AS INTEGER
    scroll AS INTEGER
    scrollmax AS INTEGER
END TYPE

TYPE winType
    x AS INTEGER
    y AS INTEGER
    w AS INTEGER
    h AS INTEGER

    img AS LONG

    cap AS STRING * 128

    pid AS INTEGER
    text AS listType
END TYPE

DIM SHARED mx, my, mbr, mbl, mw

DIM tmem AS _MEM
DIM SHARED win(50) AS winType, wn

win(0).x = 10
win(0).y = 10
win(0).w = 320
win(0).h = 240
win(0).img = _NEWIMAGE(win(0).w + 1, win(0).h + 1, 32)
win(0).cap = "command prompt 0"
win(0).pid = 2
newList win(0).text
addNodeNext win(0).text.cur, ">", win(0).text.head, win(0).text
win(0).text.cx = 1
nextNode win(0).text.cur, win(0).text.head

win(1).x = 400
win(1).y = 10
win(1).w = 320
win(1).h = 240
win(1).cap = "textbox 1"
win(1).img = _NEWIMAGE(win(1).w + 1, win(1).h + 1, 32)
win(1).pid = 1
newList win(1).text
addNodeNext win(1).text.cur, "", win(1).text.head, win(1).text
nextNode win(0).text.cur, win(0).text.head

win(2).x = 200
win(2).y = 300
win(2).w = 520
win(2).h = 240
win(2).cap = "textbox 2"
win(2).img = _NEWIMAGE(win(2).w + 1, win(2).h + 1, 32)
win(2).pid = 1
newList win(2).text
addNodeNext win(2).text.cur, "I", win(2).text.head, win(2).text
addNodeNext win(2).text.cur, "am", win(2).text.cur, win(2).text
addNodeNext win(2).text.cur, "a", win(2).text.cur, win(2).text
addNodeNext win(2).text.cur, "textbox", win(2).text.cur, win(2).text
nextNode win(2).text.cur, win(2).text.head

win(3).x = 15
win(3).y = 305
win(3).w = 160
win(3).h = 120
win(3).cap = "about"
win(3).img = _NEWIMAGE(win(3).w + 1, win(3).h + 1, 32)
win(3).pid = 0
'newList win(3).text
'addNodeNext win(3).text.cur, "", win(3).text.head, win(3).text

wn = 3

DIM SHARED bg AS _INTEGER64, p1 AS _INTEGER64
p1 = _NEWIMAGE(sw, sh, 32)
bg = _NEWIMAGE(sw, sh, 32)
_DEST bg
LINE (0, 0)-(sw, sh), _RGB(0, 0, 0), BF
FOR y = 0 TO sh STEP 4
    LINE (0, y)-(sw, y), _RGB(42, 42, 42), , &H8888
    LINE (1, y + 1)-(sw, y + 1), _RGB(42, 42, 42), , &H8888
    LINE (3, y + 2)-(sw, y + 2), _RGB(42, 42, 42), , &H8888
    LINE (2, y + 3)-(sw, y + 3), _RGB(42, 42, 42), , &H8888
NEXT
'circle (sw\2, sh\2),100,_rgb(0,50,105)
'for a# = 0 to 2*3.141593 step 2*3.141593/6
'   x# = 100*cos(a#) + sw\2
'   y# = 100*sin(a#) + sh\2
'   circle(x#, y#),100,_rgb(0,50,105)
'   for b# = 0 to 2*3.141593 step 2*3.141593/6
'       xx# = x# + 100*cos(b#)
'       yy# = y# + 100*sin(b#)
'       circle(xx#, yy#),100,_rgb(0,50,105)
'       for c# = 0 to 2*3.141593 step 2*3.141593/6
'           circle(xx# + 100*cos(b#), yy# + 100*sin(b#)),100,_rgb(0,50,105)
'       next
'   next
'next
_DEST 0

SCREEN _NEWIMAGE(sw, sh, 32)

FOR i = 0 TO wn
    drawWin (i)
NEXT

redraw

DIM temp AS winType
DIM k AS LONG

DO
    mw = 0
    getMouse
    k = _KEYHIT

    IF wn >= 0 THEN

        '''process current window left mouse button events
        IF mbl THEN
            'mouse over current window
            tabw = tabWidth(0)
            IF mbox(win(0).x, win(0).y, win(0).w, win(0).h) THEN
                IF mbox(win(0).x, win(0).y, win(0).w, winBarH) AND NOT mbox(win(0).x + tabw, win(0).y, win(0).w - tabw, winBarH) THEN
                    IF mbox(win(0).x + tabw - winBarH + 3, win(0).y + 3, winBarH - 6, winBarH - 6) THEN
                        '''resize
                        _DEST p1
                        redraw
                        _DEST 0

                        boxx = win(0).x
                        boxy = win(0).y
                        boxw = win(0).w
                        boxh = win(0).h
                        drawBox boxx, boxy, boxw, boxh
                        _DISPLAY

                        stuck = 0
                        omx = mx
                        omy = my
                        DO WHILE mbl
                            getMouse

                            IF omx <> mx OR omy <> my THEN
                                IF NOT mbox(boxx, boxy, boxw, boxh) THEN
                                    IF mx <= boxx THEN
                                        stuck = stuck OR 1
                                    ELSEIF mx >= boxx + boxw THEN
                                        stuck = stuck OR 2
                                    END IF
                                    IF my <= boxy THEN
                                        stuck = stuck OR 4
                                    ELSEIF my >= boxy + boxh THEN
                                        stuck = stuck OR 8
                                    END IF
                                END IF

                                IF stuck AND 1 THEN
                                    boxx = mx
                                    boxw = win(0).w + win(0).x - mx

                                    IF boxw <= 50 THEN stuck = stuck XOR 1
                                ELSEIF stuck AND 2 THEN
                                    boxx = win(0).x
                                    boxw = mx - win(0).x

                                    IF boxw <= 50 THEN stuck = stuck XOR 2
                                END IF
                                IF stuck AND 4 THEN
                                    boxy = my
                                    boxh = win(0).h + win(0).y - my

                                    IF boxh <= 50 THEN stuck = stuck XOR 4
                                ELSEIF stuck AND 8 THEN
                                    boxy = win(0).y
                                    boxh = my - win(0).y

                                    IF boxh <= 50 THEN stuck = stuck XOR 8
                                END IF

                                _PUTIMAGE , p1
                                drawBox boxx, boxy, boxw, boxh
                                _DISPLAY

                                omx = mx
                                omy = my
                            END IF
                        LOOP

                        win(0).x = boxx
                        win(0).y = boxy
                        win(0).w = boxw
                        win(0).h = boxh
                        _FREEIMAGE win(0).img
                        win(0).img = _NEWIMAGE(win(0).w + 1, win(0).h + 1, 32)

                        SELECT CASE win(0).pid
                            CASE 1
                                win(0).text.cx = 0
                                FOR i = 1 TO win(0).text.cy
                                    prevNode win(0).text.cur, win(0).text.cur
                                NEXT
                                curlen = lenNode(win(0).text.cur)
                                IF win(0).text.cx > curlen THEN win(0).text.cx = curlen
                                win(0).text.cy = 0
                            CASE 2
                                win(0).text.cx = 1
                                FOR i = 1 TO win(0).text.cy
                                    prevNode win(0).text.cur, win(0).text.cur
                                NEXT
                                curlen = lenNode(win(0).text.cur)
                                IF win(0).text.cx > curlen THEN win(0).text.cx = curlen
                                win(0).text.cy = 0

                        END SELECT

                        drawWin (0)

                        redraw
                        _DISPLAY
                    ELSEIF mbox(win(0).x + 3, win(0).y + 3, winBarH - 6, winBarH - 6) THEN
                        '''close
                        DO WHILE mbr
                            getMouse
                        LOOP

                        closeWin (0)

                    ELSE
                        '''drag
                        'partial redraw
                        _DEST p1
                        _PUTIMAGE , bg

                        FOR i = wn TO 1 STEP -1
                            _PUTIMAGE (win(i).x, win(i).y), win(i).img
                        NEXT
                        _DEST 0

                        omx = mx
                        omy = my
                        owx = mx - win(0).x
                        owy = my - win(0).y
                        DO WHILE mbl
                            getMouse

                            IF mx <> omx OR my <> omy THEN
                                _PUTIMAGE (win(0).x, win(0).y), p1, , (win(0).x, win(0).y)-(win(0).x + win(0).w, win(0).y + win(0).h)
                                win(0).x = mx - owx
                                win(0).y = my - owy

                                '''''
                                '''''''''''fixxx thisss!!!
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img

                                _DISPLAY

                                omx = mx
                                omy = my
                            END IF
                        LOOP
                    END IF
                END IF

            ELSE
                'mouse over other windows
                FOR i = 1 TO wn
                    tabw = tabWidth(i)
                    IF mbox(win(i).x, win(i).y, win(i).w, win(i).h) AND NOT mbox(win(i).x + tabw, win(i).y, win(i).w - tabw, winBarH) THEN
                        temp = win(i)
                        FOR j = i TO 1 STEP -1
                            win(j) = win(j - 1)
                        NEXT
                        win(0) = temp

                        drawWin (0)
                        drawWin (1)
                        redraw
                        _DISPLAY

                        EXIT FOR
                    END IF
                NEXT

            END IF
        END IF
        '''

        '''process current window right mouse button events
        IF mbr THEN
            '''close [old]
            'if mbox(win(0).x, win(0).y, win(0).w, winBarH) then
            '   do while mbr
            '       getMouse
            '   loop

            '   closeWin(0)

            'end if
        END IF
        '''

        '''process current window mouse wheel events
        IF mw <> 0 THEN
            SELECT CASE win(0).pid
                CASE 1
                    '''scroll

                    IF mw < 0 THEN
                        'scrolling up
                        IF win(0).text.scroll > 0 THEN
                            win(0).text.scroll = win(0).text.scroll - 1

                            IF win(0).text.cy < (win(0).h - winBarH - 6) \ fontSize - 1 THEN
                                win(0).text.cy = win(0).text.cy + 1
                            ELSEIF -1 THEN
                                prevNode win(0).text.cur, win(0).text.cur
                                curlen = lenNode(win(0).text.cur)
                                IF win(0).text.cx > curlen THEN win(0).text.cx = curlen
                            END IF
                        END IF
                        'scrolling down
                    ELSEIF mw > 0 THEN
                        IF win(0).text.scroll + mw < win(0).text.scrollmax THEN
                            win(0).text.scroll = win(0).text.scroll + 1

                            IF win(0).text.cy > 0 THEN
                                win(0).text.cy = win(0).text.cy - 1
                            ELSEIF -1 THEN
                                nextNode win(0).text.cur, win(0).text.cur
                                curlen = lenNode(win(0).text.cur)
                                IF win(0).text.cx > curlen THEN win(0).text.cx = curlen
                            END IF
                        END IF
                    END IF

                    drawWin (0)
                    _PUTIMAGE (win(0).x, win(0).y), win(0).img
                    _DISPLAY
            END SELECT
        END IF
        '''

        '''process current window keyboard controls
        IF k <> 0 THEN
            SELECT CASE win(0).pid
                'about window
                CASE 0

                    'textbox
                CASE 1
                    SELECT CASE k

                        'right
                        CASE 19712
                            IF win(0).text.cx < LEN(readNode$(win(0).text.cur)) AND win(0).text.cx < (win(id).w - 8) \ 8 THEN
                                win(0).text.cx = win(0).text.cx + 1
                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            END IF

                            'left
                        CASE 19200
                            IF win(0).text.cx > 0 THEN win(0).text.cx = win(0).text.cx - 1
                            drawWin (0)
                            _PUTIMAGE (win(0).x, win(0).y), win(0).img
                            _DISPLAY

                            'down
                        CASE 20480
                            IF win(0).text.cy < (win(0).h - winBarH - 6) \ fontSize - 1 THEN
                                IF win(0).text.cy + win(0).text.scroll + 1 < win(0).text.scrollmax THEN
                                    win(0).text.cy = win(0).text.cy + 1

                                    nextNode win(0).text.cur, win(0).text.cur
                                    curlen = lenNode(win(0).text.cur)
                                    IF win(0).text.cx > curlen THEN win(0).text.cx = curlen

                                    drawWin (0)
                                    _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                    _DISPLAY
                                END IF
                            ELSEIF win(0).text.scroll + win(0).text.cy + 1 < win(0).text.scrollmax THEN
                                win(0).text.scroll = win(0).text.scroll + 1

                                nextNode win(0).text.cur, win(0).text.cur
                                curlen = lenNode(win(0).text.cur)
                                IF win(0).text.cx > curlen THEN win(0).text.cx = curlen

                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            END IF

                            'up
                        CASE 18432
                            IF win(0).text.cy > 0 THEN
                                win(0).text.cy = win(0).text.cy - 1

                                prevNode win(0).text.cur, win(0).text.cur
                                curlen = lenNode(win(0).text.cur)
                                IF win(0).text.cx > curlen THEN win(0).text.cx = curlen

                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            ELSEIF win(0).text.scroll > 0 THEN
                                win(0).text.scroll = win(id).text.scroll - 1

                                prevNode win(0).text.cur, win(0).text.cur
                                curlen = lenNode(win(0).text.cur)
                                IF win(0).text.cx > curlen THEN win(0).text.cx = curlen

                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            END IF

                            'enter
                        CASE 13
                            IF win(0).text.cx = 0 THEN
                                addNodePrev win(0).text.cur, "", win(0).text.cur, win(0).text
                                nextNode win(0).text.cur, win(0).text.cur

                            ELSEIF win(0).text.cx >= lenNode(win(0).text.cur) THEN
                                addNodeNext win(0).text.cur, "", win(0).text.cur, win(0).text
                            ELSEIF -1 THEN
                                rn$ = readNode$(win(0).text.cur)
                                curlen = lenNode(win(0).text.cur)
                                lt$ = LEFT$(rn$, win(0).text.cx)
                                rt$ = MID$(rn$, win(0).text.cx + 1, curlen - cx - 1)

                                writeNode win(0).text.cur, lt$

                                addNodeNext win(0).text.cur, rt$, win(0).text.cur, win(0).text
                            END IF

                            win(0).text.cx = 0

                            IF win(0).text.cy < (win(0).h - winBarH - 6) \ fontSize - 1 THEN
                                IF win(0).text.cy + win(0).text.scroll + 1 < win(0).text.scrollmax THEN
                                    win(0).text.cy = win(0).text.cy + 1

                                    drawWin (0)
                                    _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                    _DISPLAY
                                END IF
                            ELSEIF win(0).text.scroll + win(0).text.cy + 1 < win(0).text.scrollmax THEN
                                win(0).text.scroll = win(0).text.scroll + 1

                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            END IF

                            'backspace
                        CASE 8
                            IF win(0).text.cx > 0 THEN
                                rn$ = readNode$(win(0).text.cur)

                                lt$ = LEFT$(rn$, win(0).text.cx - 1)
                                rt$ = MID$(rn$, win(0).text.cx + 1, curlen - cx - 1)

                                writeNode win(0).text.cur, lt$ + rt$

                                win(0).text.cx = win(0).text.cx - 1

                            ELSEIF win(0).text.cx = 0 THEN
                                IF win(0).text.cy > 0 OR win(0).text.scroll > 0 THEN
                                    s$ = readNode$(win(0).text.cur)
                                    tmem = win(0).text.cur
                                    prevNode win(0).text.cur, win(0).text.cur
                                    win(0).text.cx = lenNode(win(0).text.cur)
                                    s$ = readNode$(win(0).text.cur) + s$
                                    writeNode win(0).text.cur, s$
                                    rmNode tmem, win(0).text

                                    IF win(0).text.cy > 0 THEN
                                        win(0).text.cy = win(0).text.cy - 1
                                    ELSEIF win(0).text.cy = 0 THEN
                                        IF win(0).text.scroll > 0 THEN
                                            win(0).text.scroll = win(0).text.scroll - 1
                                        END IF
                                    END IF
                                END IF
                            END IF

                            drawWin (0)
                            _PUTIMAGE (win(0).x, win(0).y), win(0).img
                            _DISPLAY

                        CASE 32 TO 126
                            IF win(0).text.cx < (win(id).w - 8) \ 8 THEN


                                rn$ = readNode$(win(0).text.cur)
                                IF win(0).text.cx = 0 THEN
                                    rn$ = "$" + rn$
                                    writeNode win(0).text.cur, CHR$(k) + readNode$(win(0).text.cur)
                                ELSEIF win(0).text.cx >= lenNode(win(0).text.cur) THEN
                                    writeNode win(0).text.cur, readNode$(win(0).text.cur) + CHR$(k)
                                ELSEIF -1 THEN
                                    curlen = lenNode(win(0).text.cur)
                                    writeNode win(0).text.cur, LEFT$(rn$, win(0).text.cx) + CHR$(k) + MID$(rn$, win(0).text.cx + 1, curlen - cx - 1)
                                END IF

                                win(0).text.cx = win(0).text.cx + 1

                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            END IF
                    END SELECT

                    'command prompt
                CASE 2
                    SELECT CASE k

                        'right
                        CASE 19712
                            IF win(0).text.cx < LEN(readNode$(win(0).text.cur)) AND win(0).text.cx < (win(id).w - 8) \ 8 THEN
                                win(0).text.cx = win(0).text.cx + 1
                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            END IF

                            'left
                        CASE 19200
                            IF win(0).text.cx > 0 THEN win(0).text.cx = win(0).text.cx - 1
                            drawWin (0)
                            _PUTIMAGE (win(0).x, win(0).y), win(0).img
                            _DISPLAY


                            'enter
                        CASE 13
                            result$ = ""
                            rn$ = readNode$(win(0).text.cur)

                            IF cmd(result$, RIGHT$(rn$, LEN(rn$) - 1), 0) THEN
                                addNodePrev win(0).text.cur, rn$, win(0).text.cur, win(0).text
                                addNodeNext win(0).text.cur, result$, win(0).text.cur, win(0).text
                                nextNode win(0).text.cur, win(0).text.cur
                                writeNode win(0).text.cur, ">"

                                win(0).text.cx = 1


                                IF win(0).text.cy < (win(0).h - winBarH - 6) \ fontSize - 1 THEN
                                    IF win(0).text.cy + win(0).text.scroll + 1 < win(0).text.scrollmax THEN
                                        win(0).text.cy = win(0).text.cy + 2

                                        drawWin (0)
                                        _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                        _DISPLAY
                                    END IF
                                ELSEIF win(0).text.scroll + win(0).text.cy + 1 < win(0).text.scrollmax THEN
                                    win(0).text.scroll = win(0).text.scroll + 1

                                    drawWin (0)
                                    _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                    _DISPLAY
                                END IF
                            ELSE
                                closeWin (0)
                            END IF

                            'backspace
                        CASE 8
                            IF win(0).text.cx > 1 THEN
                                rn$ = readNode$(win(0).text.cur)

                                lt$ = LEFT$(rn$, win(0).text.cx - 1)
                                rt$ = MID$(rn$, win(0).text.cx + 1, curlen - cx - 1)

                                writeNode win(0).text.cur, lt$ + rt$

                                win(0).text.cx = win(0).text.cx - 1
                            END IF

                            drawWin (0)
                            _PUTIMAGE (win(0).x, win(0).y), win(0).img
                            _DISPLAY

                        CASE 32 TO 126
                            IF win(0).text.cx < (win(id).w - 8) \ 8 THEN


                                rn$ = readNode$(win(0).text.cur)
                                IF win(0).text.cx = 0 THEN
                                    rn$ = "$" + rn$
                                    writeNode win(0).text.cur, CHR$(k) + readNode$(win(0).text.cur)
                                ELSEIF win(0).text.cx >= lenNode(win(0).text.cur) THEN
                                    writeNode win(0).text.cur, readNode$(win(0).text.cur) + CHR$(k)
                                ELSEIF -1 THEN
                                    curlen = lenNode(win(0).text.cur)
                                    writeNode win(0).text.cur, LEFT$(rn$, win(0).text.cx) + CHR$(k) + MID$(rn$, win(0).text.cx + 1, curlen - cx - 1)
                                END IF

                                win(0).text.cx = win(0).text.cx + 1

                                drawWin (0)
                                _PUTIMAGE (win(0).x, win(0).y), win(0).img
                                _DISPLAY
                            END IF
                    END SELECT
            END SELECT
        END IF
        '''

    END IF
LOOP UNTIL k = 27
SYSTEM

FUNCTION cmd (result AS STRING, in AS STRING, id)
    SELECT CASE in
        CASE "version"
            result = "vwm version 2"
            cmd = -1
        CASE "time"
            result = STR$(TIMER)
            cmd = -1
        CASE "exit"
            cmd = 0
        CASE ELSE
            result = "error"
            cmd = -1
    END SELECT
END SUB

SUB getMouse ()
    DO
        mx = _MOUSEX
        my = _MOUSEY
        mbl = _MOUSEBUTTON(1)
        mbr = _MOUSEBUTTON(2)
        mw = mw + _MOUSEWHEEL
    LOOP WHILE _MOUSEINPUT
END SUB

SUB redraw ()
    _PUTIMAGE , bg

    FOR i = wn TO 0 STEP -1
        _PUTIMAGE (win(i).x, win(i).y), win(i).img
    NEXT
END SUB

SUB closeWin (id)
    _FREEIMAGE win(id).img

    SELECT CASE win(id).pid
        CASE 1 TO 2
            rmList win(id).text
    END SELECT

    wn = wn - 1
    FOR i = id TO wn
        win(i) = win(i + 1)
    NEXT

    redraw
    _DISPLAY
END SUB

SUB resizeWin (id)
END SUB

FUNCTION tabWidth (id)
    s$ = RTRIM$(win(id).cap)
    IF (LEN(s$) * 8 + winBarH * 4) > win(id).w THEN
        tabWidth = win(id).w
    ELSE
        tabWidth = winBarH * 4 + LEN(s$) * 8
    END IF
END FUNCTION

SUB drawWin (id)
    _DEST win(id).img

    'LINE (0, winBarH)-STEP(win(id).w, win(id).h - winBarH), _RGB(0, 0, 0), BF
    'LINE (0, winBarH)-STEP(win(id).w, win(id).h - winBarH), _RGB(255, 255, 255), B

    s$ = RTRIM$(win(id).cap)
    IF (LEN(s$) * 8 + winBarH * 4) > win(id).w THEN
        ss$ = LEFT$(s$, (win(id).w - winBarH * 4) \ 8)
        tabw = win(id).w
    ELSE
        ss$ = s$
        tabw = winBarH * 4 + LEN(s$) * 8
    END IF

    'line (0, 0)-step(tabw, winBarH),_rgb(0,0,0),bf
    'line (0, 0)-step(tabw, winBarH),_rgb(255,255,255),b
    'line (4, 4)-step(winBarH-8, winBarH-8),_rgb(255,255,255),b
    'line (tabw-winBarH+4, 4)-step(winBarH-8, winBarH-8),_rgb(255,255,255),b


    '''BeOS
    DIM g1 AS LONG, g2 AS LONG, g3 AS LONG
    IF id = 0 THEN
        'g1 = _RGB(255, 255, 82)
        'g2 = _RGB(255, 206, 0)
        'g3 = _RGB(173, 123, 0)
        c0 = _RGBA32(255, 255, 57, 255)
        c1 = _RGBA32(255, 239, 33, 255)
        c2 = _RGBA32(255, 206, 0, 255)
        c3 = _RGBA32(239, 181, 0, 255)
        c4 = _RGBA32(214, 156, 0, 255)
    ELSE
        'g1 = _RGB(255, 255, 255)
        'g2 = _RGB(239, 239, 239)
        'g3 = _RGB(156, 156, 156)
        c0 = _RGBA32(255, 255, 255, 255)
        c1 = c0
        c2 = _RGBA32(239, 239, 239, 255)
        c3 = _RGBA32(222, 214, 222, 255)
        c4 = _RGBA32(198, 189, 198, 255)
    END IF

    '255.255.255 - c0/c1
    '239.239.239 - c2
    '222.214.222 - c3
    '198.189.198 - c4

    LINE (0, 0)-(tabw, 0), _RGB(156, 156, 156)
    LINE (tabw + 1, winBarH)-(win(id).w - 1, winBarH), _RGB(156, 156, 156)
    LINE (0, 0)-(0, win(id).h - 1), _RGB(156, 156, 156)
    LINE (tabw, 1)-(tabw, winBarH), _RGB(99, 99, 99)
    LINE (0, win(id).h)-(win(id).w, win(id).h), _RGB(99, 99, 99)
    LINE (win(id).w, winBarH - 1)-(win(id).w, win(id).h), _RGB(99, 99, 99)
    LINE (1, win(id).h - 1)-(win(id).w - 1, win(id).h - 1), _RGB(140, 140, 140)
    LINE (win(id).w - 1, win(id).h - 1)-(win(id).w - 1, winBarH + 1), _RGB(140, 140, 140)
    LINE (1, winBarH + 1)-(1, win(id).h - 2), _RGB(255, 255, 255)
    LINE (tabw - 1, winBarH + 1)-(win(id).w - 2, winBarH + 1), _RGB(255, 255, 255)
    LINE (2, winBarH + 1)-(tabw - 2, winBarH + 1), _RGB(222, 222, 222)
    LINE (2, winBarH + 2)-(win(id).w - 2, win(id).h - 2), _RGB(222, 222, 222), B
    LINE (3, winBarH + 3)-(3, win(id).h - 3), _RGB(156, 156, 156)
    LINE (3, winBarH + 3)-(win(id).w - 4, winBarH + 3), _RGB(156, 156, 156)

    LINE (4, win(id).h - 3)-(win(id).w - 4, win(id).h - 3), _RGB(255, 255, 255)
    LINE (win(id).w - 3, win(id).h - 3)-(win(id).w - 3, winBarH + 3), _RGB(255, 255, 255)

    LINE (1, 1)-(tabw - 1, 1), c1
    LINE (1, 1)-(1, winBarH), c1
    LINE (2, 2)-(tabw - 2, winBarH), c2, BF
    LINE (tabw - 1, 2)-(tabw - 1, winBarH), c3


    LeftButtonStartX = 6
    LeftButtonStartY = 6
    LINE (LeftButtonStartX + 0, LeftButtonStartY + 0)-(LeftButtonStartX + 13, LeftButtonStartY + 0), c4
    LINE (LeftButtonStartX + 0, LeftButtonStartY + 0)-(LeftButtonStartX + 0, LeftButtonStartY + 13), c4
    LINE (LeftButtonStartX + 1, LeftButtonStartY + 1)-(LeftButtonStartX + 13, LeftButtonStartY + 1), c0
    LINE (LeftButtonStartX + 1, LeftButtonStartY + 1)-(LeftButtonStartX + 1, LeftButtonStartY + 13), c0
    LINE (LeftButtonStartX + 1, LeftButtonStartY + 13)-(LeftButtonStartX + 13, LeftButtonStartY + 13), c0
    LINE (LeftButtonStartX + 13, LeftButtonStartY + 13)-(LeftButtonStartX + 13, LeftButtonStartY + 1), c0
    LINE (LeftButtonStartX + 2, LeftButtonStartY + 12)-(LeftButtonStartX + 12, LeftButtonStartY + 12), c4
    LINE (LeftButtonStartX + 12, LeftButtonStartY + 12)-(LeftButtonStartX + 12, LeftButtonStartY + 2), c4
    LINE (LeftButtonStartX + 6, LeftButtonStartY + 11)-(LeftButtonStartX + 11, LeftButtonStartY + 11), c3
    LINE (LeftButtonStartX + 7, LeftButtonStartY + 10)-(LeftButtonStartX + 11, LeftButtonStartY + 10), c3
    LINE (LeftButtonStartX + 9, LeftButtonStartY + 9)-(LeftButtonStartX + 11, LeftButtonStartY + 9), c3
    LINE (LeftButtonStartX + 10, LeftButtonStartY + 8)-(LeftButtonStartX + 11, LeftButtonStartY + 8), c3
    LINE (LeftButtonStartX + 9, LeftButtonStartY + 7)-(LeftButtonStartX + 11, LeftButtonStartY + 7), c3
    PSET (LeftButtonStartX + 11, LeftButtonStartY + 6), c3
    LINE (LeftButtonStartX + 9, LeftButtonStartY + 8)-(LeftButtonStartX + 8, LeftButtonStartY + 9), c2
    LINE (LeftButtonStartX + 8, LeftButtonStartY + 8)-(LeftButtonStartX + 7, LeftButtonStartY + 9), c3
    LINE (LeftButtonStartX + 11, LeftButtonStartY + 3)-(LeftButtonStartX + 10, LeftButtonStartY + 4), c1
    LINE (LeftButtonStartX + 6, LeftButtonStartY + 10)-(LeftButtonStartX + 5, LeftButtonStartY + 11), c2
    LINE (LeftButtonStartX + 11, LeftButtonStartY + 5)-(LeftButtonStartX + 10, LeftButtonStartY + 6), c2
    LINE (LeftButtonStartX + 11, LeftButtonStartY + 4)-(LeftButtonStartX + 4, LeftButtonStartY + 11), c2
    LINE (LeftButtonStartX + 9, LeftButtonStartY + 5)-(LeftButtonStartX + 5, LeftButtonStartY + 9), c2
    LINE (LeftButtonStartX + 4, LeftButtonStartY + 10)-(LeftButtonStartX + 3, LeftButtonStartY + 11), c1
    LINE (LeftButtonStartX + 11, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 11), c2
    LINE (LeftButtonStartX + 10, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 10), c1
    LINE (LeftButtonStartX + 8, LeftButtonStartY + 3)-(LeftButtonStartX + 3, LeftButtonStartY + 8), c2
    LINE (LeftButtonStartX + 8, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 8), c1
    LINE (LeftButtonStartX + 7, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 7), c1
    LINE (LeftButtonStartX + 6, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 6), c1
    LINE (LeftButtonStartX + 5, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 5), c1
    LINE (LeftButtonStartX + 4, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 4), c0
    LINE (LeftButtonStartX + 3, LeftButtonStartY + 2)-(LeftButtonStartX + 2, LeftButtonStartY + 3), c1
    PSET (LeftButtonStartX + 2, LeftButtonStartY + 2), c0
    PSET (LeftButtonStartX + 9, LeftButtonStartY + 2), c1
    PSET (LeftButtonStartX + 2, LeftButtonStartY + 9), c1

    RightButtonStartX = (tabw - 14) - 6
    RightButtonStartY = 6
    LINE (RightButtonStartX + 0, RightButtonStartY + 0)-(RightButtonStartX + 7, RightButtonStartY + 0), c4
    LINE (RightButtonStartX + 0, RightButtonStartY + 0)-(RightButtonStartX + 0, RightButtonStartY + 7), c4
    LINE (RightButtonStartX + 1, RightButtonStartY + 1)-(RightButtonStartX + 8, RightButtonStartY + 1), c0
    LINE (RightButtonStartX + 1, RightButtonStartY + 1)-(RightButtonStartX + 1, RightButtonStartY + 8), c0
    LINE (RightButtonStartX + 8, RightButtonStartY + 1)-(RightButtonStartX + 8, RightButtonStartY + 8), c0
    LINE (RightButtonStartX + 1, RightButtonStartY + 8)-(RightButtonStartX + 8, RightButtonStartY + 8), c0
    LINE (RightButtonStartX + 2, RightButtonStartY + 7)-(RightButtonStartX + 7, RightButtonStartY + 7), c4
    LINE (RightButtonStartX + 7, RightButtonStartY + 2)-(RightButtonStartX + 7, RightButtonStartY + 7), c4
    LINE (RightButtonStartX + 9, RightButtonStartY + 3)-(RightButtonStartX + 13, RightButtonStartY + 3), c4
    LINE (RightButtonStartX + 9, RightButtonStartY + 4)-(RightButtonStartX + 13, RightButtonStartY + 4), c0
    LINE (RightButtonStartX + 13, RightButtonStartY + 4)-(RightButtonStartX + 13, RightButtonStartY + 13), c0
    LINE (RightButtonStartX + 13, RightButtonStartY + 13)-(RightButtonStartX + 4, RightButtonStartY + 13), c0
    LINE (RightButtonStartX + 4, RightButtonStartY + 13)-(RightButtonStartX + 4, RightButtonStartY + 9), c0
    LINE (RightButtonStartX + 3, RightButtonStartY + 13)-(RightButtonStartX + 3, RightButtonStartY + 9), c4
    LINE (RightButtonStartX + 12, RightButtonStartY + 5)-(RightButtonStartX + 12, RightButtonStartY + 12), c4
    LINE (RightButtonStartX + 12, RightButtonStartY + 12)-(RightButtonStartX + 5, RightButtonStartY + 12), c4
    LINE (RightButtonStartX + 11, RightButtonStartY + 6)-(RightButtonStartX + 11, RightButtonStartY + 11), c3
    LINE (RightButtonStartX + 6, RightButtonStartY + 11)-(RightButtonStartX + 11, RightButtonStartY + 11), c3
    LINE (RightButtonStartX + 5, RightButtonStartY + 9)-(RightButtonStartX + 5, RightButtonStartY + 11), c1
    LINE (RightButtonStartX + 6, RightButtonStartY + 9)-(RightButtonStartX + 6, RightButtonStartY + 10), c1
    PSET (RightButtonStartX + 7, RightButtonStartY + 9), c1
    LINE (RightButtonStartX + 9, RightButtonStartY + 5)-(RightButtonStartX + 11, RightButtonStartY + 5), c1
    LINE (RightButtonStartX + 9, RightButtonStartY + 6)-(RightButtonStartX + 10, RightButtonStartY + 6), c1
    PSET (RightButtonStartX + 9, RightButtonStartY + 7), c1
    LINE (RightButtonStartX + 10, RightButtonStartY + 9)-(RightButtonStartX + 10, RightButtonStartY + 10), c2
    PSET (RightButtonStartX + 9, RightButtonStartY + 10), c2
    LINE (RightButtonStartX + 10, RightButtonStartY + 8)-(RightButtonStartX + 8, RightButtonStartY + 10), c1
    LINE (RightButtonStartX + 10, RightButtonStartY + 7)-(RightButtonStartX + 7, RightButtonStartY + 10), c2
    LINE (RightButtonStartX + 2, RightButtonStartY + 2)-(RightButtonStartX + 4, RightButtonStartY + 2), c1
    LINE (RightButtonStartX + 2, RightButtonStartY + 3)-(RightButtonStartX + 3, RightButtonStartY + 3), c1
    PSET (RightButtonStartX + 2, RightButtonStartY + 4), c1
    LINE (RightButtonStartX + 6, RightButtonStartY + 2)-(RightButtonStartX + 6, RightButtonStartY + 4), c2
    LINE (RightButtonStartX + 2, RightButtonStartY + 6)-(RightButtonStartX + 3, RightButtonStartY + 6), c2
    LINE (RightButtonStartX + 5, RightButtonStartY + 2)-(RightButtonStartX + 2, RightButtonStartY + 5), c2
    LINE (RightButtonStartX + 5, RightButtonStartY + 3)-(RightButtonStartX + 3, RightButtonStartY + 5), c1
    LINE (RightButtonStartX + 4, RightButtonStartY + 6)-(RightButtonStartX + 6, RightButtonStartY + 6), c3
    PSET (RightButtonStartX + 6, RightButtonStartY + 5), c3
    LINE (RightButtonStartX + 4, RightButtonStartY + 5)-(RightButtonStartX + 5, RightButtonStartY + 5), c2
    PSET (RightButtonStartX + 5, RightButtonStartY + 4), c2

    'line (tabw-(3*winBarH\4)+7, (winBarH-8)\2+3)-step

    COLOR _RGB(0, 0, 0), c2
    _PRINTSTRING (winBarH * 2, 6), ss$

    '''

    'line (winBarH*2, 0)-step(len(s$)*8,winBarH),_rgb(255,255,0),b

    '_printstring (winBarH*2, 5), ss$

    's$ = left$(win(id).cap, win(id).w\8 - 3)
    '_printstring (4, 3), s$
    'line (0, winBarH) - step(win(id).w, 0), _rgb(255,255,255)
    'line (win(id).w - winBarH+3, 3)-step(winBarH-6,winBarH-6), _rgb(255,255,255), b

    SELECT CASE win(id).pid
        CASE 1
            LINE (4, winBarH + 4)-(win(id).w - 4, win(id).h - 4), _RGB(255, 255, 255), BF
            COLOR _RGB(0, 0, 0), _RGB(255, 255, 255)
        CASE 2
            LINE (4, winBarH + 4)-(win(id).w - 4, win(id).h - 4), _RGB(0, 0, 0), BF
            COLOR _RGB(0, 255, 0), _RGB(0, 0, 0)
    END SELECT

    SELECT CASE win(id).pid
        CASE 0
            LINE (4, winBarH + 4)-(win(id).w - 4, win(id).h - 4), _RGB(156, 156, 156), BF
            COLOR _RGB(0, 0, 0), _RGB(156, 156, 156)
            _PRINTSTRING ((win(id).w - 3 * 8) \ 2, (win(id).h - 2 * fontSize) \ 2), "vwm"
            _PRINTSTRING ((win(id).w - 9 * 8) \ 2, (win(id).h - 2 * fontSize) \ 2 + 16), "version 2"
        CASE 1 TO 2

            DIM temp AS _MEM
            temp = win(id).text.cur

            maxy = (win(id).h - winBarH + 8) \ fontSize - 1
            FOR i = win(id).text.cy TO maxy
                IF temp.OFFSET = win(id).text.tail.OFFSET THEN EXIT FOR
                _PRINTSTRING (4, winBarH + 4 + i * fontSize), readNode$(temp)
                nextNode temp, temp
            NEXT
            temp = win(id).text.cur
            IF win(id).text.cy > 0 THEN
                FOR i = win(id).text.cy - 1 TO 0 STEP -1
                    prevNode temp, temp
                    IF temp.OFFSET = win(id).text.head.OFFSET THEN EXIT FOR
                    _PRINTSTRING (4, winBarH + 4 + i * fontSize), readNode$(temp)
                NEXT
            END IF

            LINE (4 + 8 * win(id).text.cx, winBarH + 4 + fontSize * win(id).text.cy)-STEP(8, fontSize), , B
    END SELECT

    _DEST 0
END SUB

SUB drawBox (boxx, boxy, boxw, boxh)
    w3 = boxw \ 3
    h3 = (boxh - winBarH) \ 3
    DIM c AS LONG
    c = _RGB(255, 0, 255)
    LINE (boxx, boxy)-STEP(boxw, boxh), c, B
    LINE (boxx, boxy + winBarH)-STEP(boxw, 0), c

    LINE (boxx + w3, boxy + winBarH)-STEP(0, boxh - winBarH), c, B
    LINE (boxx + 2 * w3, boxy + winBarH)-STEP(0, boxh - winBarH), c, B
    LINE (boxx, boxy + h3 + winBarH)-STEP(boxw, 0), c, B
    LINE (boxx, boxy + 2 * h3 + winBarH)-STEP(boxw, 0), c, B
END SUB

FUNCTION mbox (x, y, w, h)
    IF mx >= x THEN
        IF my >= y THEN
            IF mx <= x + w THEN
                IF my <= y + h THEN
                    mbox = -1
                    EXIT FUNCTION
                END IF
            END IF
        END IF
    END IF

    mbox = 0
END FUNCTION

SUB addNodeNext (new AS _MEM, s$, cur AS _MEM, list1 AS listType)
    DIM node AS nodeType
    DIM temp AS _MEM
    DIM n AS _MEM

    list1.scrollmax = list1.scrollmax + 1

    temp = _MEMNEW(LEN(node))

    nextNode n, cur

    node.strLen = LEN(s$)
    IF node.strLen > 0 THEN
        node.str = _MEMNEW(LEN(s$))
        _MEMPUT node.str, node.str.OFFSET, s$
    END IF
    node.n = n
    node.p = cur
    _MEMPUT temp, temp.OFFSET, node

    node = _MEMGET(cur, cur.OFFSET, nodeType)
    node.n = temp
    _MEMPUT cur, cur.OFFSET, node

    node = _MEMGET(n, n.OFFSET, nodeType)
    node.p = temp
    _MEMPUT n, n.OFFSET, node

    new = temp
END SUB

SUB addNodePrev (new AS _MEM, s$, cur AS _MEM, list1 AS listType)
    DIM node AS nodeType
    DIM temp AS _MEM
    DIM p AS _MEM

    list1.scrollmax = list1.scrollmax + 1
    temp = _MEMNEW(LEN(node))

    prevNode p, cur

    node.strLen = LEN(s$)
    IF node.strLen > 0 THEN
        node.str = _MEMNEW(LEN(s$))
        _MEMPUT node.str, node.str.OFFSET, s$
    END IF

    node.n = cur
    node.p = p
    _MEMPUT temp, temp.OFFSET, node

    node = _MEMGET(cur, cur.OFFSET, nodeType)
    node.p = temp
    _MEMPUT cur, cur.OFFSET, node

    node = _MEMGET(p, p.OFFSET, nodeType)
    node.n = temp
    _MEMPUT p, p.OFFSET, node

    new = temp
END SUB

SUB rmNode (cur AS _MEM, list1 AS listType)
    DIM node AS nodeType
    DIM n AS _MEM
    DIM p AS _MEM

    list1.scrollmax = list1.scrollmax - 1
    'remove the string first
    node = _MEMGET(cur, cur.OFFSET, nodeType)
    IF node.strLen > 0 THEN
        _MEMFREE node.str
    END IF

    nextNode n, cur
    prevNode p, cur

    node = _MEMGET(p, p.OFFSET, nodeType)
    node.n = n
    _MEMPUT p, p.OFFSET, node

    node = _MEMGET(n, n.OFFSET, nodeType)
    node.p = p
    _MEMPUT n, n.OFFSET, node

    _MEMFREE cur
END SUB

SUB nextNode (new AS _MEM, old AS _MEM)
    DIM node AS nodeType

    node = _MEMGET(old, old.OFFSET, nodeType)
    new = node.n
END SUB

SUB prevNode (new AS _MEM, old AS _MEM)
    DIM node AS nodeType

    node = _MEMGET(old, old.OFFSET, nodeType)
    new = node.p
END SUB

FUNCTION lenNode (cur AS _MEM)
    DIM node AS nodeType

    node = _MEMGET(cur, cur.OFFSET, nodeType)
    lenNode = node.strLen
END FUNCTION

FUNCTION readNode$ (cur AS _MEM)
    DIM node AS nodeType

    node = _MEMGET(cur, cur.OFFSET, nodeType)
    IF node.strLen = 0 THEN
        readNode$ = ""
        EXIT FUNCTION
    END IF
    s$ = STRING$(node.strLen, 0)
    _MEMGET node.str, node.str.OFFSET, s$

    readNode$ = s$
END SUB

SUB writeNode (cur AS _MEM, s$)
    DIM node AS nodeType

    'remove old string, free memory
    node = _MEMGET(cur, cur.OFFSET, nodeType)
    IF node.strLen > 0 THEN _MEMFREE node.str

    'add new string
    node.strLen = LEN(s$)
    IF node.strLen > 0 THEN
        node.str = _MEMNEW(LEN(s$))
        _MEMPUT node.str, node.str.OFFSET, s$
    END IF
    _MEMPUT cur, cur.OFFSET, node
END SUB

SUB newList (new AS listType)
    DIM node AS nodeType

    new.head = _MEMNEW(LEN(node))
    new.tail = _MEMNEW(LEN(node))
    new.cx = 0
    new.cy = 0
    new.scroll = 0
    new.scrollmax = 0

    s$ = "head"
    node.strLen = LEN(s$)
    node.str = _MEMNEW(LEN(s$))
    node.n = new.tail
    node.p = new.tail
    _MEMPUT node.str, node.str.OFFSET, s$
    _MEMPUT new.head, new.head.OFFSET, node

    s$ = "tail"
    node.strLen = LEN(s$)
    node.str = _MEMNEW(LEN(s$))
    node.n = new.head
    node.p = new.head
    _MEMPUT node.str, node.str.OFFSET, s$
    _MEMPUT new.tail, new.tail.OFFSET, node

END SUB

SUB printList (cur AS listType)
    DIM temp AS _MEM

    nextNode temp, cur.head
    DO
        IF temp.OFFSET = cur.tail.OFFSET THEN EXIT DO

        PRINT readNode$(temp)
        nextNode temp, temp
    LOOP
END SUB

SUB rmList (cur AS listType)
    DIM temp AS _MEM
    DIM temp2 AS _MEM

    nextNode temp, cur.head
    DO
        IF temp.OFFSET = cur.tail.OFFSET THEN EXIT DO

        temp2 = temp
        nextNode temp, temp2
        rmNode temp2, cur
    LOOP

    rmNode cur.head, cur
    rmNode cur.tail, cur
END SUB

[bplus]

Pretty nice the text boxes scroll with wheel and do more than one page.

Thumbs up! It's better than what I've come up with so far.

[vince]

Complex Number Library

This is a work in progress collection of operators and functions for complex numbers.  Mostly in the form of SUBs and FUNCTIONs at the end of the code.  The demo shows the library in use in several complex number topics with domain coloring plots as well as a simple example of how to plot the Mandelbrot set at the end.

Code: (Select All)

defdbl a-z

const sw = 800
const sh = 600

dim shared pi
pi = 4*atn(1)

zoom = 140

dim as long i, j, k, xx, yy

screen _newimage(sw, sh, 32)

for i=0 to 9
        '''plots
        for yy=0 to sh
        for xx=0 to sw

                x = (xx - sw/2)/zoom
                y = (sh/2 - yy)/zoom

                select case i
                case 0
                        u = x
                        v = y
                        pset (xx, yy), hrgb(u, v)
                case 1
                        u = x
                        v = y
                        pset (xx, yy), checker(u, v)
                case 2
                        'w = 1/z
                        cdiv u, v, 1, 0, x, y

                        'pset (xx, yy), hrgb(u, v)
                        pset (xx, yy), checker(u, v)

                case 3
                        'w = sin(1/z)

                        'extra zoom
                        d = 0.35*(x*x + y*y)
                        if d<>0 then
                                u = sin(x/d)*cosh(-y/d)
                                v = cos(x/d)*sinh(-y/d)
                        else
                                u = 0
                                v = 0
                        end if

                        pset (xx, yy), hrgb(u, v)
                        'pset (xx, yy), checker(u, v)

                case 4
                        'extra zoom
                        u = 0.56*x
                        v = 0.56*y
                        for j=0 to 14
                                uu = u*u - v*v + 0.35
                                vv = 2*u*v + 0.0

                                u = uu
                                v = vv
                        next

                        pset (xx, yy), hrgb(u, v)
                        'pset (xx, yy), checker(u, v)

                case 5
                        cmul u, v, 1, 0, x - cos(2*pi/3), y + sin(2*pi/3)
                        cmul u, v, u, v, x - cos(2*pi/3), y - sin(2*pi/3)
                        cmul u, v, u, v, x - 1, y
                        'cdiv u, v, u, v, x - 1, y

                        pset (xx, yy), hrgb(u, v)
                        'pset (xx, yy), checker(u, v)

                case 6
                        'CIF numerical integration
                        'f(z_0) = (2 pi i)^-1 int_C f(z)/(z - z0) dz

                        n = 35

                        uu = 0
                        vv = 0

                        for j=0 to n - 1
                                'C: z(t)
                                p = 1.5*cos(j*2*pi/n)
                                q = 1.5*sin(j*2*pi/n)

                                'f(z(t)):
                                cmul u, v, 1, 0, p - cos(2*pi/3), q + sin(2*pi/3)
                                cmul u, v, u, v, p - cos(2*pi/3), q - sin(2*pi/3)
                                cmul u, v, u, v, p - 1, q

                                'f(z)/(z - z0)
                                cdiv u, v, u, v, p - x, q - y

                                'dz/dt
                                cmul u, v, u, v, -1.5*sin(j*2*pi/n), 1.5*cos(j*2*pi/n)

                                if j = 0 or j = n - 1 then
                                        uu = uu + 0.5*u
                                        vv = vv + 0.5*v
                                else
                                        uu = uu + u
                                        vv = vv + v
                                end if
                        next
                        'dt
                        u = uu*2*pi/n
                        v = vv*2*pi/n

                        '1/(2 pi i)
                        cmul u, v, u, v, 0, -1/(2*pi)

                        pset (xx, yy), hrgb(u, v)
                        'pset (xx, yy), checker(u, v)

                case 7
                        'extra zoom
                        x = x*0.5
                        y = y*0.5

                        p = 1
                        q = 0

                        for j=0 to 5
                                cmul uu, vv, 1, 0, -0.4, -0.18*(j - 2.1)
                                cmul p, q, p, q, x - uu - 0.2, y - vv
                                cdiv p, q, p, q, x - uu + 0.2, y - vv + 0.1
                        next
                        for j=0 to 2
                                cmul uu, vv, 1, 0, 0.4, -0.18*(j - 2.1) - 0.18*2.1/2
                                cdiv p, q, p, q, x - uu - 0.2, y - vv
                                cmul p, q, p, q, x - uu + 0.2, y - vv + 0.1
                        next

                        u = p
                        v = q

                        pset (xx, yy), grey(u, v)

                case 8
                        'extra zoom
                        u = 0.66*x - 0.5
                        v = 0.66*y
                        x0 = u
                        y0 = v
                        for j=0 to 3
                                uu = u*u - v*v + x0
                                vv = 2*u*v + y0

                                u = uu
                                v = vv
                        next

                        'pset (xx, yy), hrgb(u, v)
                        pset (xx, yy), checker(u, v)
                case 9
                        'extra zoom
                        u = 0.66*x - 0.5
                        v = 0.66*y
                        x0 = u
                        y0 = v
                        for j=0 to 70
                                uu = u*u - v*v + x0
                                vv = 2*u*v + y0

                                u = uu
                                v = vv
                        next

                        'pset (xx, yy), hrgb(u, v)
                        pset (xx, yy), checker(u, v)
                end select
        next
        next

        '''diagrams
        select case i
        case 0
                _title "w = z polar contouring"
        case 1
                _title "w = z checkerboard"
        case 2
                _title "w = 1/z singularity"
        case 3
                _title "w = sin(1/z) essential singularity"
        case 4
                _title "Julia fractal"
        case 5
                _title "tri mass"
        case 6
                _title "Cauchy integral formula"
                a = 0
                x = 1.5*cos(a)
                y = 1.5*sin(a)
                circle (x*zoom + sw/2, sh/2 - y*zoom), 3, _rgb(255,255,0)

                for a=0 to 2*pi step 2*pi/n
                        x = 1.5*cos(a)
                        y = 1.5*sin(a)

                        line -(x*zoom + sw/2, sh/2 - y*zoom), _rgb(255,255,0)
                        circle step(0,0), 3, _rgb(255,255,0)
                next

        case 7
                _title "mutual inductance"

                sleep

                'extra zoom
                m = zoom/0.5

                'this diagram is a JB original
                'left
                a = -pi/2
                x = sw/2/m + 0.2*cos(a) - 0.4
                y = sh/2/m + 0.18*sin(a) + (a*0.18*0.5/pi) - 2.1*0.18
                for t=x to 0 step -0.001
                        circlef (x - t)*m, y*m, 1, _rgb(0,0,0)
                next
                for a = -pi/2 to 5*2*pi + 2*pi + pi/2 step 0.01
                        x = sw/2/m + 0.2*cos(a) - 0.4
                        y = sh/2/m + 0.18*sin(a) + (a*0.18*0.5/pi) - 2.1*0.18
                        circlef x*m, y*m, 1, _rgb(0,0,0)
                next
                a = 5*2*pi + 2*pi + pi/2
                x = sw/2/m + 0.2*cos(a) - 0.4
                y = sh/2/m + 0.18*sin(a) + (a*0.18*0.5/pi) - 2.1*0.18
                for t=x to 0 step -0.001
                        circlef (x - t)*m, y*m, 1, _rgb(0,0,0)
                next
                'right
                a = -pi/2
                x = sw/2/m - 0.2*cos(a) + 0.4
                y = sh/2/m + 0.18*sin(a) + (a*0.18*0.5)/pi - 2.1*0.18 + 0.18*2.1/4
                for t=0 to 1.5 step 0.001
                        circlef (x + t)*m, y*m, 1, _rgb(0,0,0)
                next
                for a = -pi/2 to 2*2*pi + 2*pi + pi/2 step 0.01
                        x = sw/2/m - 0.2*cos(a) + 0.4
                        y = sh/2/m + 0.18*sin(a) + (a*0.18*0.5)/pi - 2.1*0.18 + 0.18*2.1/4
                        circlef x*m, y*m, 1, _rgb(0,0,0)
                next
                a = 2*2*pi + 2*pi + pi/2
                x = sw/2/m - 0.2*cos(a) + 0.4
                y = sh/2/m + 0.18*sin(a) + (a*0.18*0.5)/pi - 2.1*0.18 + 0.18*2.1/4
                for t=0 to 1.5 step 0.001
                        circlef (x + t)*m, y*m, 1, _rgb(0,0,0)
                next

        case 8
                _title "checkerboard Mandelbrot"
        end select

        sleep
next

_title "escape time example with nth order Mandelbrot"

zoom = 210

for n=2 to 6
        'line (0, 0)-(sw, sh), _rgb(255,255,255), bf

        for yy=0 to sh
        for xx=0 to sw
                x = (xx - sw/2)/zoom - 0.5
                y = (sh/2 - yy)/zoom

                u = 0
                v = 0
                for i=0 to 140
                        'f(z) = z^n + c
                        cexp u, v, u, v, n, 0
                        u = u + x
                        v = v + y
                        if u*u + v*v > 4 then exit for
                next
                if i>=140 then
                        pset (xx, yy), _rgb(0,0,0)
                else
                        pset (xx, yy), _rgb(255,255,255)
                end if
        next
        next

        sleep
next

system


sub circlef(x as long, y as long, r as long, c as long)
        dim as long x0, y0, e
        x0 = r
        y0 = 0
        e = -r
        do while y0 < x0
                if e <=0 then
                        y0 = y0 + 1
                        line (x - x0, y + y0)-(x + x0, y + y0), c, bf
                        line (x - x0, y - y0)-(x + x0, y - y0), c, bf
                        e = e + 2*y0
                else
                        line (x - y0, y - x0)-(x + y0, y - x0), c, bf
                        line (x - y0, y + x0)-(x + y0, y + x0), c, bf
                        x0 = x0 - 1
                        e = e - 2*x0
                end if
        loop
        line (x - r, y)-(x + r, y), c, bf
end sub

function grey~&(x, y)
        m = sqr(x*x + y*y)
        a = (pi + _atan2(y, x))/(2*pi)

        m = log(1 + 100*m)

        'polar contouring
        n = 16
        mm = m*5000 mod 500
        p = abs(a*n - int(a*n))

        g = 1 - 0.0007*mm - 0.21*p

        grey = _rgb(255*g, 255*g, 255*g)
end function

function checker~&(xx, yy)
        if 1 then
                x = xx
                y = yy
        else 'polar checkerboard
                x = _atan2(yy, xx)/(pi/4)
                y = sqr(xx*xx + yy*yy)

                y = log(1 + 1000*y)
        end if

        z = abs(x - int(x)) xor abs(y - int(y))

        if z then checker = _rgb(0,0,0) else checker = _rgb(255,255,255)
end function

function hrgb~&(x, y)
        m = sqr(x*x + y*y)
        a = (pi + _atan2(y, x))/(2*pi)

        'm = log(1 + 1000*m)

        r =  0.5 - 0.5*sin(2*pi*a - pi/2)
        g = (0.5 + 0.5*sin(2*pi*a*1.5 - pi/2)) * -(a < 0.66)
        b = (0.5 + 0.5*sin(2*pi*a*1.5 + pi/2)) * -(a > 0.33)

        'polar contouring
        n = 16
        mm = m*500 mod 500
        p = abs(a*n - int(a*n))

        r = r - 0.0005*mm - 0.14*p
        g = g - 0.0005*mm - 0.14*p
        b = b - 0.0005*mm - 0.14*p

        'cartesian shading
        if 0 then
                t = 0.03 'thickness
                xx = abs(x - int(x)) < t or abs(-x - int(-x)) < t
                yy = abs(y - int(y)) < t or abs(-y - int(-y)) < t
                if xx or yy then
                'if m > 1 then 'dont shade origin
                        r = r - 0.5
                        g = g - 0.5
                        b = b - 0.5
                'end if
                end if
        end if

        hrgb = _rgb(255*r, 255*g, 255*b)
end function

sub cmul(u, v, xx, yy, aa, bb)
        x = xx
        y = yy
        a = aa
        b = bb
        u = x*a - y*b
        v = x*b + y*a
end sub

sub cdiv(u, v, xx, yy, aa, bb)
        x = xx
        y = yy
        a = aa
        b = bb
        d = a*a + b*b
        u = (x*a + y*b)/d
        v = (y*a - x*b)/d
end sub

sub cexp(u, v, xx, yy, aa, bb)
        x = xx
        y = yy
        a = aa
        b = bb

        lnz = x*x + y*y

        if lnz = 0 then
                u = 0
                v = 0
        else
                lnz = 0.5*log(lnz)
                argz = _atan2(y, x)
                m = exp(a*lnz - b*argz)
                a = a*argz + b*lnz
                u = m*cos(a)
                v = m*sin(a)
        end if
end sub

sub clog(u, v, xx, yy)
        x = xx
        y = yy
        lnz = x*x + y*y
        if lnz=0 then
                u = 0
                v = 0
        else
                u = 0.5*log(lnz)
                v = _atan2(y, x)
        end if
end sub

function cosh(x)
        cosh = 0.5*(exp(x) + exp(-x))
end function

function sinh(x)
        sinh = 0.5*(exp(x) - exp(-x))
end function

sub csin(u, v, xx, yy)
        x = xx
        y = yy
        u = sin(x)*cosh(y)
        v = cos(x)*sinh(y)
end sub

sub ccos(u, v, xx, yy)
        x = xx
        y = yy
        u = cos(x)*cosh(y)
        v =-sin(x)*sinh(y)
end sub

function factorial~&(n)
        if n = 0 then
                factorial = 1
        else
                factorial = n*factorial(n - 1)
        end if
end function

[vince]

Dithering with an arbitrary diffusion matrix

Code: (Select All)

deflng a-z

img1 = _loadimage("nefertiti.jpg", 32)

w = _width(img1)
h = _height(img1)

img2 = _newimage(w, h, 32)
img3 = _newimage(w, h, 32)
img4 = _newimage(w, h, 32)

img5 = _newimage(w, h, 32)
img6 = _newimage(w, h, 32)
img7 = _newimage(w, h, 32)

img8 = _newimage(w, h, 32)
img9 = _newimage(w, h, 32)
img10 = _newimage(w, h, 32)

screen _newimage(w*3, h*3, 32)

redim h(2, 1) as single
h(0,0)=0:h(1,0)=-1:h(2,0)=7/16
h(0,1)=3/16:h(1,1)=5/16:h(2,1)=1/16

dither_bw img1, img2, 0.1, h()
dither img1, img3, 2, h()
dither img1, img4, 4, h()

redim h(4, 2) as single
h(0,0)=0:h(1,0)=0:h(2,0)=-1:h(3,0)=7/48:h(4,0)=5/48
h(0,1)=3/48:h(1,1)=5/48:h(2,1)=7/48:h(3,1)=5/48:h(4,1)=3/48
h(0,2)=1/48:h(1,2)=3/48:h(2,2)=5/48:h(3,2)=3/48:h(4,2)=1/48

dither_bw img1, img5, 0.1, h()
dither img1, img6, 2, h()
dither img1, img7, 4, h()

redim h(3, 2) as single
h(0,0)=0:h(1,0)=-1:h(2,0)=1/8:h(3,0)=1/8
h(0,1)=1/8:h(1,1)=1/8:h(2,1)=1/8:h(3,1)=0
h(0,2)=0:h(1,2)=1/8:h(2,2)=0:h(3,2)=0

dither_bw img1, img8, 0.1, h()
dither img1, img9, 2, h()
dither img1, img10, 4, h()

_dest 0
_putimage (0, 0), img2
_putimage (w, 0), img3
_putimage (2*w, 0), img4
_printstring (0,0),"Floyd-Steinberg"

_putimage (0, h), img5
_putimage (w, h), img6
_putimage (2*w, h), img7
_printstring (0,h),"Jarvis, Judice, and Ninke"

_putimage (0, 2*h), img8
_putimage (w, 2*h), img9
_putimage (2*w, 2*h), img10
_printstring (0,2*h),"Atkinson"


do
loop until _keyhit=27
system

'colour dither
'source image, destination image, number of colours per channel, diffusion matrix
sub dither(img1, img2, num, h() as single)
    w = _width(img1)
    h = _height(img1)

    _dest img2
    _source img2

    _putimage , img1

    for y=0 to h-1
    for x=0 to w-1

        z = point(x, y)

        r = (_red(z)*num\255)*255\num
        g = (_green(z)*num\255)*255\num
        b = (_blue(z)*num\255)*255\num

        pset (x, y), _rgb(r, g, b)

        qr = _red(z) - r
        qg = _green(z) - g
        qb = _blue(z) - b

        conv_ed img2, x, y, h(), qr, qg, qb
    next
    next
end sub

'black and white dither
'source image, destination image, bw threshold percent, diffusion matrix
sub dither_bw(img1, img2, t as double, h() as single)
    w = _width(img1)
    h = _height(img1)

    _dest img2
    _source img2

    _putimage , img1

    for y=0 to h-1
    for x=0 to w-1

        z = point(x, y)

        c = -((_red(z)+_green(z)+_blue(z))/3 > 255*t)*255

        pset (x, y), _rgb(c, c, c)

        qr = _red(z) - c
        qg = _green(z) - c
        qb = _blue(z) - c

        conv_ed img2, x, y, h(), qr, qg, qb
    next
    next
end sub

sub conv_ed(img, x0, y0, h() as single, qr, qg, qb)
    for y=0 to ubound(h,2)
    for x=0 to ubound(h,1)
        if h(x,y)=-1 then
            xx = x
            yy = y
        end if
    next
    next

    _source img
    _dest img

    for y=0 to ubound(h,2)
    for x=0 to ubound(h,1)
        if h(x,y) > 0 then
            r = _red(point(x0-xx+x, y0-yy+y)) + qr*h(x,y)
            g = _green(point(x0-xx+x, y0-yy+y)) + qg*h(x,y)
            b = _blue(point(x0-xx+x, y0-yy+y)) + qb*h(x,y)
           
            pset (x0-xx+x, y0-yy+y), _rgb(r, g, b)
        end if
    next
    next
end sub

[vince]

Software rotozoom example

Code: (Select All)

deflng a-z

'const sw = 800
'const sh = 600

dim shared pi as double
pi = 4*atn(1)

img = _loadimage("leopardx.jpg", 32)
w = _width(img)
h = _height(img)

dim zoom as double
dim a as double
zoom = 2.5

a = 2*sqr(w*w/4 + h*h/4)*zoom

if h < a then h = a

screen _newimage(w + a*2, h, 32)

_putimage (0,0), img

dim rot as double
do
    rot = rot + 0.1

    line (w, 0)-step(a*2, a),_rgb(0,0,0),bf
    rotzoom img, w + a/2, a/2, rot, zoom
    rotzoomb img, w + a + a/2, a/2, rot, zoom

    _display
    _limit 30
loop until _keyhit = 27

sleep
system

sub rotzoomb(img, x0, y0, rot as double, zoom as double)
    dim a as double
    dim xx as double, yy as double
    dim dx as double, dy as double

    w = _width(img)
    h = _height(img)

    if zoom = 0 then zoom = 1
    a = 2*sqr(w*w/4 + h*h/4)*zoom

    _source img

    for y=0 to a
    for x=0 to a
        xx = (x - a/2)*cos(rot)/zoom - (y - a/2)*sin(rot)/zoom + w/2
        yy = (x - a/2)*sin(rot)/zoom + (y - a/2)*cos(rot)/zoom + h/2

        if (int(xx) >=0 and int(xx) < w - 1 and int(yy) >= 0 and int(yy) < h - 1) then
            tl = point(int(xx), int(yy))
            tr = point(int(xx) + 1, int(yy))
            bl = point(int(xx), int(yy) + 1)
            br = point(int(xx) + 1, int(yy) + 1)

            dx = xx - int(xx)
            dy = yy - int(yy)

            r = _round((1 - dy)*((1 - dx)*  _red(tl) + dx*  _red(tr)) + dy*((1 - dx)*  _red(bl) + dx*  _red(br)))
            g = _round((1 - dy)*((1 - dx)*_green(tl) + dx*_green(tr)) + dy*((1 - dx)*_green(bl) + dx*_green(br)))
            b = _round((1 - dy)*((1 - dx)* _blue(tl) + dx* _blue(tr)) + dy*((1 - dx)* _blue(bl) + dx* _blue(br)))

            pset (x0 - a/2 + x, y0 - a/2 + y), _rgb(r, g, b)

        elseif (int(xx) >=0 and int(xx) < w - 1 and int(yy) >= 0 and int(yy) < h - 1) then
            pset (x0 - a/2 + x, y0 - a/2 + y), point(int(xx), int(yy))
        end if
    next
    next
end sub


sub rotzoom(img, x0, y0, rot as double, zoom as double)
    dim a as double

    w = _width(img)
    h = _height(img)

    if zoom = 0 then zoom = 1
    a = 2*sqr(w*w/4 + h*h/4)*zoom

    _source img

    for y=0 to a
    for x=0 to a
        xx = (x - a/2)*cos(rot)/zoom - (y - a/2)*sin(rot)/zoom + w/2
        yy = (x - a/2)*sin(rot)/zoom + (y - a/2)*cos(rot)/zoom + h/2

        if ((xx) >= 0 and (xx) < w and (yy) >=0 and (yy) < h) then
            pset (x0 - a/2 + x, y0 - a/2 + y), point(int(xx), int(yy))
        end if
    next
    next
end sub

[vince]

classic starscape mod

Code: (Select All)

randomize timer
dim shared pi, d, zz, sw, sh
pi = 4*atn(1)
d = 700
zz = 2100
sw = 1280
sh = 720

type stype
    x as double
    y as double
    z as double
end type
dim shared star(2000) as stype

type gtype
    x as double
    y as double
    z as double

    r as double
    r1 as double
    r2 as double

    a1 as double
    a2 as double
    a3 as double
end type
dim shared galaxy(100) as gtype


screen _newimage(sw, sh, 32)

for i=0 to 2000
    star(i).x = 5000*rnd-2500
    star(i).y = 5000*rnd-2500
    star(i).z = 5000*rnd-2500
next
for i=0 to 30
    galaxy(i).x = 4000*rnd-2000
    galaxy(i).y = 4000*rnd-2000
    galaxy(i).z = 4000*rnd-2000
    galaxy(i).r = 150*rnd
    galaxy(i).r1 = rnd
    galaxy(i).r2 = rnd
    galaxy(i).a1 = 2*pi*rnd
    galaxy(i).a2 = 2*pi*rnd
    galaxy(i).a3 = 4*pi*rnd - 2.5*pi*rnd
next

do
    cls

    for i=0 to 2000
        star(i).z = star(i).z - 100
        if star(i).z < 0 then
            star(i).x = 4000*rnd-2000
            star(i).y = 4000*rnd-2000
            star(i).z = 4000*rnd-2000
        end if
        x1 = star(i).x
        y1 = star(i).y
        z1 = star(i).z
        for z0 = 0 to 3
            pset (sw/2 + x1*d/(z1 + zz + z0*10), sh/2 - y1*d/(z1 + zz + z0*10)),_rgb(255 - 50*z0, 255 - 50*z0, 0)
        next
    next

    for i=0 to 30
        galaxy(i).z = galaxy(i).z - 100
        if galaxy(i).z < -zz then
            galaxy(i).x = 4000*rnd-2000
            galaxy(i).y = 4000*rnd-2000
            galaxy(i).z = 8000*rnd'-2000
            galaxy(i).r = 10*rnd + 30
            galaxy(i).r1 = rnd
            galaxy(i).r2 = rnd
            galaxy(i).a1 = 2*pi*rnd
            galaxy(i).a2 = 2*pi*rnd
            galaxy(i).a3 = 4*pi*rnd - 2.5*pi*rnd
        end if
        x1 = galaxy(i).x
        y1 = galaxy(i).y
        z1 = galaxy(i).z
        r = galaxy(i).r
        r1 = galaxy(i).r1
        r2 = galaxy(i).r2
        a1 = galaxy(i).a1
        a2 = galaxy(i).a2
        a3 = galaxy(i).a3
        drawgalaxy x1, y1, z1, r, r1, r2, a1, a2, a3
    next

    _display
    _limit 30
loop until _keyhit = 27
sleep
system

sub drawgalaxy(x1, y1, z1, r, r1, r2, a1, a2, u)
    dim c as _unsigned long

    for a=0 to u step 0.1
        for i=0 to 0.001*r*(u - a)^3.5
            x0 = (rnd - 0.5)*0.2*r*(u - a)
            y0 = (rnd - 0.5)*0.2*r*(u - a)
            z0 = (rnd - 0.5)*0.2*r*(u - a)

            if x0*x0 + y0*y0 + z0*z0 < 2000 then
            for k=0 to 1
                x = x0 + r1*r*a*cos(a + k*pi)
                y = y0 + r2*r*a*sin(a + k*pi)
                z = z0 + 1

                rot x, y, a1
                rot y, z, a2

                c = 255*(u - a)/2
                rr = c + rnd*50
                gg = 0.2*c + rnd*50
                bb = 0
                if rr < 0 then rr = 0
                if gg < 0 then gg = 0
                if bb < 0 then bb = 0
                if rr > 255 then rr = 255
                if gg > 255 then gg = 255
                if bb > 255 then bb = 255
                rr = rr - z1/100
                gg = gg - z1/100
                bb = bb - z1/100

                pset (sw/2 + (x + x1)*d/(z + z1 + zz), sh/2 - (y + y1)*d/(z + z1 + zz)), _rgb(rr, gg, bb)
            next
            end if
        next
    next
end sub

sub rot(xx, yy, a)
    x = xx
    y = yy
    xx = x*cos(a) - y*sin(a)
    yy = x*sin(a) + y*cos(a)
end sub

[Dav]

Cool one!  

- Dav

[bplus]

Cool one!  

- Dav

Yeah, I think dbox was showing this or something like this.
Update: ah, his was like slideshow, not animated.

[GareBear]

Vince, This is nice animation. Liked it very well.

[bplus]

Vince, This is nice animation. Liked it very well.

If you like give him a rep point, we want to encourage him to do more.

@GareBear looks like you could use some too, post some stuff, I bet I will like it too!

If you think 'I am only a beginner' then there is this:
https://qb64phoenix.com/forum/showthread...6#pid16026
for beginners to ask or show off