Thread Rating:
  • 1 Vote(s) - 5 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Drawing Tools Subs or Functions with Demo
#43
check out this mod, B+, drag mouse and use mousewheel

Code: (Select All)

defdbl a-z
dim shared pi, p, q, uu, vv

zoom = 200

sw = 800
sh = 600

screen _newimage(sw, sh, 32)

img = _loadimage("bluemarble_small.png")
w = _width(img)
h = _height(img)

pi = 4*atn(1)
du = 2*pi/24
dv = pi/14

vv = -pi/6

drag = 0

_source img
_dest 0


do
    oz = zoom
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput
    cls

    'uu = uu + 0.01
    'vv = vv + 0.01


    if mb and drag = 1 then
        uu = (-mx - omx)*pi/sh
        vv = (my - omy)*pi/sh
    end if

    if mb and drag = 0 then
        omx = mx
        omy = my
        drag = 1
    end if

    if mb = 0 and drag = 1 then
        drag = 0
    end if

    for v=-pi/2 to pi/2 step 3/zoom
        for u=0 to 2*pi step 3/zoom
            r = cos(v)
            z = sin(v)
            x = r*cos(u)
            y = r*sin(u)

            xx = x
            yy = y
            zz = z
           
            rotz x,y,z,uu
            rotx x,y,z,vv

            sx = 0 
            sy = -1
            sz = 0 

            proj xx, yy, zz
            pp = sw/2 + zoom*p
            qq = sh/2 - zoom*q
            if pp>0 and pp<sw and qq>0 and qq<sh then

            if (x*sx + y*sy + z*sz) < 0 then

                dim c as _unsigned long
                cx = (w*u/(2*pi) ) mod w
                cy = (h - h*(v + pi/2)/pi ) mod h
                c = point(cx, cy)

                pset (sw/2 + zoom*p, sh/2 - zoom*q), c
            end if
            end if
           
        next
    next


    if drag or (zoom <> oz) then
    for v=0 to 2*pi step dv
        for u=0 to 2*pi step du

            r = cos(v)
            z = sin(v)
            x = r*cos(u)
            y = r*sin(u)

            rotz x,y,z,uu
            rotx x,y,z,vv

            sx = 0 
            sy = -1
            sz = 0 
           
            color _rgb(100,100,100)
            if  (x*sx + y*sy + z*sz) < 0 then
                r = cos(v)
                proj r*cos(u), r*sin(u), sin(v)
                pset (sw/2 + zoom*p, sh/2 - zoom*q)

                proj r*cos(u + du), r*sin(u + du), sin(v)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                r = cos(v + dv)
                proj r*cos(u + du), r*sin(u + du), sin(v + dv)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                proj r*cos(u), r*sin(u), sin(v + dv)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                r = cos(v)
                proj r*cos(u), r*sin(u), sin(v)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)
            end if

        next
    next
    end if

    _limit 30
    _display
loop until _keyhit = 27
sleep
system

sub proj(x, y, z)
    'p = x + 0.707*y
    'q = z + 0.707*y

    rotz x,y,z,uu
    rotx x,y,z,vv


    d = 10
    p = x*d/(10 + y)
    q = z*d/(10 + y)
end sub

sub rotx(x, y, z, a)
    xx = x
    yy = y*cos(a) - z*sin(a)
    zz = y*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub roty(x, y, z, a)
    xx = x*cos(a) + z*sin(a)
    yy = y
    zz = -x*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(x, y, z, a)
    xx = x*cos(a) - y*sin(a)
    yy = x*sin(a) + y*cos(a)
    zz = z

    x = xx
    y = yy
    z = zz
end sub


Attached Files Image(s)
   
Reply


Messages In This Thread
RE: Drawing Tools Subs or Functions with Demo - by vince - 09-11-2024, 02:03 PM



Users browsing this thread: 9 Guest(s)