Squares

General FreeBASIC programming questions.
Richard
Posts: 2879
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Aug 18, 2010 2:48

@ dodicat. Yes, the same as the oscilloscopic variety of Lisajous figure. Here is a blender that continuously migrates between different patterns.

Code: Select all

'===================================================================
' Lissajous Blender
'===================================================================
Const As Double TwoPi = 8 * Atn(1)
Dim As Integer m, n=1, p=1, q=1, c = 14
Dim As Double r, s
Dim As String k
Screen 19
Window (-1.01, -1.01)-( 1.01, 1.01)
Randomize

'-------------------------------------------------------------------
Do
    m = p
    n = q
    p = q
    q = 1 + Rnd * 20
    windowtitle "   m = "+Str(m) + "      n = "+Str(n) + "      p = "+Str(p) + "      q = "+Str(q)
    For s = 0 To 1 Step .002
        Screenlock
        Cls
        Pset(0,1), c
        For t As Double = 0 To TwoPi Step 1/(10*(5+m*n))
            Line -((1-s)*Sin(m*t) + s*Sin(p*t), (1-s)*Cos(n*t) + s*Cos(q*t)), c
        Next t
        Line -(0,1), c
        Screenunlock
        Sleep 1
        k = Inkey
        If k <> "" Then Exit For
    Next s
Loop While k = ""

'===================================================================
Sleep
'===================================================================
BasicScience
Posts: 469
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Aug 18, 2010 3:30

@ Dodicat. Nice paintstring. What is the rationale for using brilliant white as a "primer" when using paint to draw thick lines? I suppose Line may have some gaps when not purely horiz or vert and so filling in the rectangle with paint could be a problem. But... how is the situation improved by using a primer color first ?
Richard
Posts: 2879
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Aug 18, 2010 7:26

@ BasicScience. Paint fills to a boundary of a defined colour. If the background area to be flooded contains a section of the final colour then Paint may be blocked by the old content and will not fill all the area required.

FB line drawing code has been written so as not to leak when used with paint.

So to draw a wide line, prime the outline with a unique colour, Paint the area to the unique coloured boundary with the final colour, then overwrite the unique outline with the final colour.
BasicScience
Posts: 469
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Aug 18, 2010 17:34

Thanks. Got it. Didn't realize that paint may be blocked if flood color already exists in the defined area. I might get inspired to generate some test cases.
BasicScience
Posts: 469
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Aug 18, 2010 17:45

Actually, the use of a unique color is not to avoid the case where paint will be "blocked"... it avoids the case where paint will "leak". For example if a line that is not in the border_color crosses the bounded region, then the paint will leak out. (you probably know this... I may have misinterpreted your text).
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Aug 18, 2010 19:11

Hey guys. I have a bunch of math related questions.

Firstly. Let's say I want to define a 2d circle in 3d space. There would be two relevant angles. The angle the circle makes with xz, and the angle the circle makes with yz.

I give the center some value, say (0,0,0), and say it tilts 45 degrees in both planes. How do I draw this circle?
dodicat
Posts: 5549
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 18, 2010 19:30

BasicScience wrote:Actually, the use of a unique color is not to avoid the case where paint will be "blocked"... it avoids the case where paint will "leak". For example if a line that is not in the border_color crosses the bounded region, then the paint will leak out. (you probably know this... I may have misinterpreted your text).


Hi BasicScience
This thickline topic came up about one and a half years ago, member Roger Hunter was asking if there was a built in way of doing it.
Richard, himself and myself were at it for a day or two, I'll post the thickline sub and a simple example below.
It was Richard's idea to prime before paint, and I have since always used a primer, in thickline, thickcircle and my 2d and 3d rotators.
I suppose it makes sense, prime then paint, not only in Freebasic, but also in home improvement projects.
Here's the thickline sub, I've painted 15 random lines to an image, press spacebar for next image, esc to quit:


Code: Select all


'THICKLINE

Sub thickline(x1 As Double,_
              y1 As Double,_
              x2 As Double,_
              y2 As Double,_
              thickness As Double,_
              colour As Uinteger,_
              im as any pointer=0)
             
              dim p as uinteger
              p=Rgb(255, 255, 255)
              If thickness<2 Then
                  Line(x1,y1)-(x2,y2),colour
              Else               
Dim As Double s,h,c
h=Sqr((x2-x1)^2+(y2-y1)^2)  'hypotenuse
s=(y1-y2)/h                 'sine
c=(x2-x1)/h                 'cosine
Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
Paint im,((x1+x2)/2, (y1+y2)/2), p, p
Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),colour
Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),colour
Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
Paint im,((x1+x2)/2, (y1+y2)/2), colour, colour

End If
End Sub

' ********************************************************
Dim As Integer desktop_width, desktop_height
Screeninfo desktop_width, desktop_height
Screenres  desktop_width, desktop_height,32


dim as any pointer image
dim count as integer

do
    randomize
    count=0
  image=imagecreate(desktop_width, desktop_height,rgb(0,0,0)) 
Do
    count=count+1
    'screenlock
    thickline(_
    Int(Rnd * desktop_width), Int(Rnd * desktop_height),_
    Int(Rnd * desktop_width), Int(Rnd * desktop_height),_
    Int(4 + Rnd * desktop_height / 8),_ ' avoids lines narrower than 4
    Rgb(Int(Rnd * 255), Int(Rnd * 256), Int(Rnd * 256)),image) ' avoids prime colour

    'screenunlock
    'Sleep 1,1
   
Loop Until count=15  'number of lines

put (0,0),image,pset
sleep
imagedestroy image
loop until inkey=chr(27)


 
BasicScience
Posts: 469
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Aug 18, 2010 20:40

Back to fun. This patten starts with a square (well, except for screen aspect ratio) and rotates inward on itself. 10 points for the person who finds the instability that causes the pattern to spiral outward and grow.

Code: Select all

Type Segment
    x1 as integer
    y1 as integer
    x2 as integer
    y2 as integer
end type
screenres 640,640,32
window (1,1)-(639,639)
Dim S as Segment Ptr
S = CALLocate (4*len(Segment))
'Starting values
    With s[0]
        .x1 = 1
        .y1 = 1
        .x2 = 639
        .y2 = 1
    end with
    With s[1]
        .x1 = 639
        .y1 = 1
        .x2 = 639
        .y2 = 639
    end with
    with s[2]
        .x1 = 639
        .y1 = 639
        .x2 = 1
        .y2 = 639
    end with
    with s[3]
        .x1 = 1
        .y1 = 639
        .x2 = 1
        .y2 = 1
    end with
   
'original squate
    For i as integer = 0 to 3
        with s[i]
            line(.x1,.y1)-(.x2,.y2),rgb(255,255,255)
        end with
    next

'The loop
Dim as integer indx = 0, Next_Indx = 0
Dim as single slope, dx, dy, dist
Do
    indx = indx + 1
    if indx > 3 then indx = 0
    with S[indx]
        'Start where the prior line segment ended
        if indx <> 0 then
            .x1 = S[indx-1].x2
            .y1 = S[indx-1].y2
        else
            .x1 = S[3].x2
            .y1 = S[3].y2
        end if
        'find endpoint
        Next_Indx = Indx + 1    'index for next line segment
        IF Next_Indx > 3 then Next_Indx = 0
        dist  = sqr((S[Next_Indx].x2 - S[Next_Indx].x1)^2 + (S[Next_Indx].y2 - S[Next_Indx].y1)^2)
        if S[Next_Indx].x2 - S[Next_Indx].x1 <> 0 THEN
            slope = (s[Next_Indx].y2 - S[Next_Indx].y1) / (S[Next_Indx].x2 - S[Next_Indx].x1)
            IF slope <> 0 then
                dx = (dist/20) / sqr(1+slope^2)
                dy = dx*abs(slope)
                'correct for sign
                if indx = 0 or indx = 1 then dx = -dx
                if indx = 1 or indx = 2 then dy = -dy
            ELSE
                dy = 0
                dx = dist/20
                if indx = 0 or indx = 1 then dx = -dx
            end if
        else
            dx = 0
            dy = dist/20
            if indx = 1 or indx = 2 then dy = -dy
        end IF
        .x2 = S[Next_Indx].x1 + int(dx)
        .y2 = S[Next_Indx].y1 + int(dy)
        Line (.x1, .y1)-(.x2,.y2), rgb(0, 255, 255)
    end with
    sleep  10
loop until dist > 800
sleep

Richard
Posts: 2879
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Aug 18, 2010 20:55

@ rolliebollocks. I think what you are trying to do is to define a “great circle”. Imagine a sphere, (a bit like the Earth), then define a great circle that passes through two geographical points x(0°E,alpha°N) and y(90°E,beta°N). This is a circle defined by the intersection of the spherical surface with a plane passing through the centre of the sphere and those two points.

You should generate the circle parametrically in t, (for t = 0 to TwoPi), as if drawn on the xy plane.
Where r is the radius of the circle (and sphere) the (x,y,z) coordinates will be;

Code: Select all

'===================================================================
' great circle in 3D
'===================================================================
Dim As Double alpha = 60     ' tilt in the x direction
Dim As Double beta = 45      ' tilt in the y direction
Dim As Double c, s, w, x, y, z, t, r = 10 ' radius

'===================================================================
Const As Double TwoPi = 8 * Atn(1)
alpha = alpha * TwoPi / 360 ' convert to radians
beta = beta * TwoPi / 360
dim as string f = "####.### ####.### ####.### ####.### ####.### "

print             "  (t)       x        y        z      check r "
For t = 0 To TwoPi Step TwoPi / 20
    ' first a parametric point on the equator
    x = r * Cos(t)
    y = r * Sin(t)
    z = 0
    ' then rotate by alpha in the xz plane about the y axis
    c = Cos(alpha)
    s = Sin(alpha)
    w = x * c - z * s
    z = x * s + z * c
    x = w
    ' final rotate by beta in the yz plane about the x axis
    c = Cos(beta)
    s = Sin(beta)
    w = y * c - z * s
    z = y * s + z * c
    y = w
    Print Using f; t, x, y, z, sqr(x*x + y*y + z*z)
Next t
print

'===================================================================
Sleep
'===================================================================
Last edited by Richard on Aug 19, 2010 5:10, edited 1 time in total.
BasicScience
Posts: 469
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Aug 18, 2010 21:16

OK, use the principle of similar triangles to make the math a bit easier and faster.

Code: Select all

Type Segment
    x1 as integer
    y1 as integer
    x2 as integer
    y2 as integer
end type
screenres 640,640,32
window (1,1)-(639,639)
Dim S as Segment Ptr
S = CALLocate (4*len(Segment))
'Starting values
    With s[0]
        .x1 = 1
        .y1 = 1
        .x2 = 639
        .y2 = 1
    end with
    With s[1]
        .x1 = 639
        .y1 = 1
        .x2 = 639
        .y2 = 639
    end with
    with s[2]
        .x1 = 639
        .y1 = 639
        .x2 = 1
        .y2 = 639
    end with
    with s[3]
        .x1 = 1
        .y1 = 639
        .x2 = 1
        .y2 = 1
    end with
   
'original squate
    For i as integer = 0 to 3
        with s[i]
            line(.x1,.y1)-(.x2,.y2),rgb(255,255,255)
        end with
    next

'The loop
Dim as integer indx = 0, Next_Indx = 0
Dim as single slope, dx, dy, dist
Do
    indx = indx + 1
    if indx > 3 then indx = 0
    with S[indx]
        'Start where the prior line segment ended
        if indx <> 0 then
            .x1 = S[indx-1].x2
            .y1 = S[indx-1].y2
        else
            .x1 = S[3].x2
            .y1 = S[3].y2
        end if
        'find endpoint
        Next_Indx = Indx + 1    'index for next line segment
        IF Next_Indx > 3 then Next_Indx = 0
        'dist  = sqr((S[Next_Indx].x2 - S[Next_Indx].x1)^2 + (S[Next_Indx].y2 - S[Next_Indx].y1)^2)
        dx = (S[Next_indx].x2 - S[next_indx].x1)/20
        dy = (S[next_indx].y2 - S[Next_indx].y1)/20
        .x2 = S[Next_Indx].x1 + int(dx)
        .y2 = S[Next_Indx].y1 + int(dy)
        Line (.x1, .y1)-(.x2,.y2), rgb(0, 255, 255)
    end with
    sleep  10
loop until abs(dx) + abs(dy) < 2
sleep
Richard
Posts: 2879
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Aug 18, 2010 21:25

@BasicScience and dodicat. This is a faster version of the thick line algorithm. It avoids painting an area twice. It also significantly reduces the computation needed for the outline.

Code: Select all

#Macro thickline(t)
Dim As Double s,h,c,ht
Dim As Uinteger prime = 15  ' adjust RGB for your screen mode depth
h = Sqr(((np(1))-(np(3)))^2+((np(2))-(np(4)))^2)
s = ((np(4))-np(2))/h
c = (np(1)-(np(3)))/h
ht = t/2    ' precompute t/2
' first draw the outline in primer
Line (np(1)+s*ht, np(2)+c*ht) - (np(1)-s*ht, np(2)-c*ht), prime
Line -(np(3)-s*ht, np(4)-c*ht), prime
Line -(np(3)+s*ht, np(4)+c*ht), prime
Line -(np(1)+s*ht, np(2)+c*ht), prime   ' close the primer outline path

' flood fill the outline
if t < 3 then ' avoid problems using Paint between very close lines
    Line (np(3), np(4)) - (np(1), np(2)), colour
else
    Paint ((np(3)+np(1))/2, (np(4)+np(2))/2), colour, prime ' modified
end if

' finally colour the primer outline by following exactly the same path
Line (np(1)+s*ht, np(2)+c*ht) - (np(1)-s*ht, np(2)-c*ht), colour
Line -(np(3)-s*ht, np(4)-c*ht), colour
Line -(np(3)+s*ht, np(4)+c*ht), colour
Line -(np(1)+s*ht, np(2)+c*ht), colour
#EndMacro

Randomize timer
Screen 19
Dim As Double np(1 To 4)

Dim As Integer colour = 8
for i as integer = 1 to 20
    For i As Integer = 1 To 4
        np(i) = Rnd * 600
    Next i
    thickline(10)
next i
Sleep
dodicat
Posts: 5549
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 18, 2010 22:28

Hi BasicScience
You didn't give us much time.
I fudged your original for 1 out of 10.

Code: Select all


Type Segment
    x1 As Integer
    y1 As Integer
    x2 As Integer
    y2 As Integer
End Type
screenres 640,640,32
Window (1,1)-(639,639)
Dim S As Segment Ptr
S = CALLocate (4*Len(Segment))
'Starting values
    With s[0]
        .x1 = 1
        .y1 = 1
        .x2 = 639
        .y2 = 1
    End With
    With s[1]
        .x1 = 639
        .y1 = 1
        .x2 = 639
        .y2 = 639
    End With
    With s[2]
        .x1 = 639
        .y1 = 639
        .x2 = 1
        .y2 = 639
    End With
    With s[3]
        .x1 = 1
        .y1 = 639
        .x2 = 1
        .y2 = 1
    End With
   
'original squate
    For i As Integer = 0 To 3
        With s[i]
            Line(.x1,.y1)-(.x2,.y2),rgb(255,255,255)
        End With
    Next

'The loop
Dim As Integer indx = 0, Next_Indx = 0
Dim As Single slope, dx, dy, dist
dim as single length,lastlength=10000
dim count as double
Do
    indx = indx + 1
    If indx > 3 Then indx = 0
    With S[indx]
        'Start where the prior line segment ended
        If indx <> 0 Then
            .x1 = S[indx-1].x2
            .y1 = S[indx-1].y2
        Else
            .x1 = S[3].x2
            .y1 = S[3].y2
        End If
        'find endpoint
        Next_Indx = Indx + 1    'index for next line segment
        If Next_Indx > 3 Then Next_Indx = 0
        dist  = Sqr((S[Next_Indx].x2 - S[Next_Indx].x1)^2 + (S[Next_Indx].y2 - S[Next_Indx].y1)^2)
        If S[Next_Indx].x2 - S[Next_Indx].x1 <> 0 Then
            slope = (s[Next_Indx].y2 - S[Next_Indx].y1) / (S[Next_Indx].x2 - S[Next_Indx].x1)
            If slope <> 0 Then
                dx = (dist/20) / Sqr(1+slope^2)
                dy = dx*Abs(slope)
                'correct for sign
                If indx = 0 Or indx = 1 Then dx = -dx
                If indx = 1 Or indx = 2 Then dy = -dy
            Else
                dy = 0
                dx = dist/20
                If indx = 0 Or indx = 1 Then dx = -dx
            End If
        Else
            dx = 0
            dy = dist/20
            If indx = 1 Or indx = 2 Then dy = -dy
        End If
        .x2 = S[Next_Indx].x1 + Int(dx)
        .y2 = S[Next_Indx].y1 + Int(dy)
        Line (.x1, .y1)-(.x2,.y2), rgb(0, 255, 255)
       
        length=sqr( (.x1-.x2)^2+(.y1-.y2)^2)
       
        if (lastlength)=(length) then
        count=count+1
    end if
    if count>=2 then exit do
        lastlength=length
       
   
    End With
    Sleep  10
Loop Until dist > 800

Sleep

 
dodicat
Posts: 5549
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 18, 2010 22:48

@ Richard
Nice one Richard.
I see you are taking the benifit of macro speed.
Only one thing though, If you want to use your thickline a few times in different parts of a program, then you have to give your macro, as it stands, it's own scope.
I'll give it a try, dim shared the variables outside the macro.
In the meantime:

Code: Select all

#Macro thickline(t)
scope
Dim As Double s,h,c,ht
Dim As Uinteger prime = 15  ' adjust RGB for your screen mode depth
h = Sqr(((np(1))-(np(3)))^2+((np(2))-(np(4)))^2)
s = ((np(4))-np(2))/h
c = (np(1)-(np(3)))/h
ht = t/2    ' precompute t/2
' first draw the outline in primer
Line (np(1)+s*ht, np(2)+c*ht) - (np(1)-s*ht, np(2)-c*ht), prime
Line -(np(3)-s*ht, np(4)-c*ht), prime
Line -(np(3)+s*ht, np(4)+c*ht), prime
Line -(np(1)+s*ht, np(2)+c*ht), prime   ' close the primer outline path

' flood fill the outline
If t < 3 Then ' avoid problems using Paint between very close lines
    Line (np(3), np(4)) - (np(1), np(2)), colour
Else
    Paint ((np(3)+np(1))/2, (np(4)+np(2))/2), colour, prime ' modified
End If

' finally colour the primer outline by following exactly the same path
Line (np(1)+s*ht, np(2)+c*ht) - (np(1)-s*ht, np(2)-c*ht), colour
Line -(np(3)-s*ht, np(4)-c*ht), colour
Line -(np(3)+s*ht, np(4)+c*ht), colour
Line -(np(1)+s*ht, np(2)+c*ht), colour
end scope
#EndMacro

Randomize Timer
Screen 19
Dim As Double np(1 To 4)

Dim As Integer colour = 8
For i As Integer = 1 To 20
    For i As Integer = 1 To 4
        np(i) = Rnd * 600
    Next i
    thickline(10)
Next i
sleep
cls
'Macro must have it's own scope(DONE) to draw these two
thickline(20)
sleep
thickline(40)
Sleep
 
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Aug 18, 2010 23:46

@Richard

Thanks. That'll be tomorrow's challenge. That's exactly what I was a after. All the interior slices of a sphere. The equation which represents them all.

@Dodicat

Keep this Breshenham gun handy for when the vamps are stalking. It draws a stake for Cross sake!

Code: Select all

#include once "fbgfx.bi"

#include once "fbgfx.bi"

sub ThickLine ( screenbuffer as fb.image ptr, x1 as single, y1 as single, x2 as single, y2 as single, thickness as integer, clr as uinteger )
#DEFINE screenxsize 799
#DEFINE screenysize 599
    dim as ubyte ptr pixdata =  Cast( Ubyte Ptr, screenbuffer ) + Sizeof( FB.IMAGE )
    dim as single dx(thickness), dy(thickness), l=0.0
   
    for i as integer = 1 to thickness
        dx(i) = ( x2 - (i-1) - x1 - (i-1) )
        dy(i) = ( y2 - (i-1) - y1 - (i-1) )
        l = SQR(dx(i)*dx(i)+dy(i)*dy(i))
        dx(i)/=l:dy(i)/=l
    next
   
    dim as integer xscreen=0, yscreen=0
    for i as single = 0 to l
        for ii as integer = 1 to thickness
            xscreen = x1+(i*dx(ii))
            yscreen = y1+(i*dy(ii))
            if xscreen > screenxsize then Continue For
            if yscreen > screenysize then Continue For
            if xscreen < 0 then Continue For
            if yscreen < 0 then Continue For
            Cast (uinteger ptr, pixdata + ( yscreen * screenbuffer->Pitch ))[ xscreen ] = clr
        next
    next
end sub
RANDOMIZE TIMER

Screen 19,32,,fb.gfx_ALPHA_PRIMITIVES

dim shared as fb.image ptr screenbuffer
screenbuffer = imagecreate(800,600)
dim as double t

Thickline(screenbuffer, 100,100,508,167,5,RGB(255,0,0))
Put (0,0),screenbuffer,trans
sleep
BasicScience
Posts: 469
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Aug 19, 2010 0:27

@ Richard & Dodicat,

I've put in many hours for a thick line routine and then extended it for dashed lines. Moreover, I wanted the routines to work for sparse points (e.g. end points of a long line) or dense point representation of non-linear functions.

My best solution to date build on Ecplizer's thick line routine (slow, not good for games, but the cleanest I've seen). I modified his routine to handle floating point coordinates, then coupled it with my own dashed line routine (much more complicated than you might originally think).

Alas... none of this build on the paint-flood approach we've been discussing.

Code: Select all

'  Thick line routine
'  Slow, but very clean
'
'  Author:   Quinton Roberts (Eclipzer)
'            Original operates on integer only.  No scaling for View, Window
'
'  Modified: Steve Cannon
'            Accepts floating point x,y and scaling by View, Window
'
SUB Thick_Line (byval sx1 as single, byval sy1 as single, byval sx2 as single, byval sy2 as single, _
    byval thickness as integer, byval c as uinteger)
   
    'Avoid the dumb cases
    If thickness < 1 then thickness = 1
    If thickness = 1 then 
        Line (sx1, sy1) - (sx2, sy2), C
        exit sub
    end if
   
    'Conversion to integer (physical screen) coordinates
        DIM as integer x1, y1, x2, y2
        DIM as integer vx1, vy1, vx2, vy2
        DIM as single x_min, y_min, x_max, y_max
        DIM as integer screen_width, screen_height
        ScreenInfo Screen_Width, Screen_Height
        'Get viewport
        ScreenControl (11, vx1, vy1, vx2, vy2)

        'Get Window Extremes
            ' This method works if Window (xmin, ymin) - (xmax, ymax) has been defined
            x_min = pmap(0,2) :         x_max = pmap(vx2-vx1+1,2)
            y_min = pmap(vy2-vy1,3) :   y_max = pmap(-1,3)

        IF y_min > y_max then       ' Oops, default Window with y increasing DOWN the page
            ' Use this method to get max values
            x_max = pmap(vx2-vx1,2)
            y_max = pmap(0,3)
        end if

        'Convert to native screen (pixel) coordinates
        x1 =  (sx1-x_min)/(x_max-x_min)*(vx2-vx1+1)
        x2 =  (sx2-x_min)/(x_max-x_min)*(vx2-vx1+1)

        'Y-axis is tricky
        'If necessary, invert to cartesian coordinates with increasing y going upward
        IF y_min > y_max then
            y1 =  screen_Height - (sy1-y_min)/(y_max-y_min)*(vy2-vy1+1)
            y2 =  Screen_Height - (sy2-y_min)/(y_max-y_min)*(vy2-vy1+1)
        ELSE
            y1 =   (y_max - sy1)/(y_max-y_min)*(vy2-vy1+1) -1
            y2 =   (y_max - sy2)/(y_max-y_min)*(vy2-vy1+1) -1
        end if
       
    'Set default scale
    Window
   
    'Eclipzer routine f rom here
   
    Dim As single t2=(thickness/2)
 
    Dim As integer bx(1)={x1,x2}
    Dim As integer by(1)={y1,y2}
   
    Dim As Integer LI=0,RI=1
    Dim As Integer TI=0,BI=1
   
    If bx(LI)>bx(RI) Then Swap LI,RI
    If by(TI)>by(BI) Then Swap TI,BI
   
    Dim As Single dx=(bx(RI)-bx(LI))
    Dim As Single dy=(by(RI)-by(LI))
   
    Dim As Single dydx=dy/dx
    Dim As Single dydx2=dydx*dydx
   
    Dim As Single b=y1-dydx*x1,d
   
    Dim As Single ndx=-dy
    Dim As Single ndy= dx
   
    Dim As Single length=Sqr(dx*dx+dy*dy)
 
    Dim As Single nx=ndx/length
    Dim As Single ny=ndy/length
   
    Dim As Single px,py
 
    For y As single =by(TI)-t2  To by(BI)+t2     'modified here with + 1
      For x As single =bx(LI)-t2  To bx(RI)+t2   'modified here with + 1
       
        If dx Then 'non-vertical line
         
          d=(dydx*x-y+b)/Sqr(dydx2+1) 'point-to-line distance equation
       
          px=x+d*nx 'projected x
          py=y+d*ny 'projected y
       
          Select Case px
          Case Is < bx(LI)
            Dim As Single xx=x-bx(LI)
            Dim As Single yy=y-by(LI)         
            d=Sqr(xx*xx+yy*yy)
           
          Case Is > bx(RI)
            Dim As Single xx=x-bx(RI)
            Dim As Single yy=y-by(RI)         
            d=Sqr(xx*xx+yy*yy)
           
          Case Else: d=Abs(d)       
          End Select
         
        Else 'vertical line       
       
          Select Case y
          Case Is < by(TI)
            Dim As Single xx=x-bx(TI)
            Dim As Single yy=y-by(TI)         
            d=Sqr(xx*xx+yy*yy)
       
          Case Is > by(BI)
            Dim As Single xx=x-bx(BI)
            Dim As Single yy=y-by(BI)         
            d=Sqr(xx*xx+yy*yy)
         
          Case Else: d=x-x1
          End Select       
        End If     
     
        IF d<t2 then Pset (x,y), C
        IF ((d-t2) <= 1) then Pset (x,y),c
        'Fancy stuff if alpha channel is used.
        'If d<t2 Then
        '  colour.a=alpha
        '  Pset(x,y),colour
        'Elseif (d-t2)<=1 Then
        '  colour.a=alpha*(1-(d-t2))
        '  Pset (x,y),colour
        'End If       
      Next
    Next


    'If necessary, reset Window before leaving
    IF y_min < y_max then window (x_min,y_min)-(x_max,y_max)
   
END SUB

' Dashed Line Routine
'
' dlen is the length of line segment (and blank) for dashed line, in units of pixels
' Line_Len is the length of the line segments
' Thick is line thickness in pixels
'
Sub Dash_Line(Byval x1 As single, Byval y1 As single, Byval x2 As single, Byval y2 As single, _
    Byval dlen As Integer, Byval pcolor As Uinteger, byval thick as integer = 1)
    Dim As Double dx, xnow, ynow, slope, Dist, Dist_Raw
    Static Line_len As Double       'Length of current line segment being rendered
    Static Draw_Flag As Byte        'Flag to track drawing a segment vs blank gap
    Dim As Byte TRUE = 1, FALSE = 0

    Dim as double delta_x = pmap(1,2) - pmap(0,2)        'delta X for 1 pixel displacement
    Dim as double delta_y = abs(pmap(1,3) - pmap(0,3))   'delta Y for 1 pixel displacement

    If x1 = x2 Then  'vertical line, pathological case for slope
        If Y2 < y1 Then Swap y1,y2
        Dist = (y2-y1) / delta_y    'in units of pixels
        ynow = y1
        IF Dist >= (dlen - Line_Len) then
            Do   
                IF Draw_Flag = TRUE then
                    Thick_Line (x1, ynow + (Thick\2)*Delta_y, x1, ynow + ((dlen - Line_len -1) - Thick\2)*Delta_Y, thick,pcolor)
                    Draw_Flag = FALSE
                ELSE
                    Draw_Flag = True
                end if
                Dist = Dist - (dlen - Line_Len)
                ynow = ynow + (dlen - Line_len)*Delta_Y
                'Line_Len = 0
                IF Dist <= dlen then
                    IF Draw_Flag = TRUE then  'complete line of partial dlen length
                        Thick_Line (x1, ynow+thick\2, x1, ynow + Dist-1-Thick\2, thick,pcolor)
                    end if
                    exit do
                end if
                Line_Len = 0
            loop
            Line_Len = Dist
        ELSE
            IF Draw_Flag = TRUE then
                'small compensation for line thickness
                IF Thick > 1 then
                    'Skip rendering on screen if Line_Len <= Thickness
                    IF Line_Len > thick then Thick_Line (x1, y1 , x1, y2 , thick, pcolor)
                ELSE
                    Thick_Line (x1, y1 , x1, y2 , thick, pcolor)
                END IF
            end if
            Line_Len = Line_Len + Dist
        end if
    Else
        ' Diagonal line segment
        Dist = Sqr(((x2-x1)/delta_x)^2 + ((y2-y1)/Delta_Y)^2)   'in units of pixels
        Dist_Raw = SQR((x2-x1)^2 + (y2-y1)^2)
        xnow = x1
        ynow = y1
        slope = (y2-y1)/(x2-x1)     
        If Dist >= (dlen - Line_Len) Then
            dx = (dlen - Line_Len)*Delta_x * ((x2-x1)/delta_x)/Dist     'in screen units
            Do
                If Draw_Flag = TRUE Then
                    Thick_Line (xnow, ynow, xnow+dx, ynow + dx*slope, thick,pcolor)
                    Draw_Flag = FALSE
                Else
                    Draw_Flag = TRUE
                End If
                'Reset Line
                Dist = Dist - (dlen - Line_len)
                xnow = xnow + dx
                ynow = ynow + dx*slope
                IF Dist <= dlen then
                    IF Draw_Flag = TRUE then  'complete line of partial dlen length
                        dx = x2 -xnow
                        Thick_Line (xnow, ynow, xnow+dx, ynow + dx*slope, thick,pcolor)
                    end if
                    exit do
                END IF
                dx = (dlen*delta_x) * ((x2-xnow)/Delta_x)/Dist
                Line_Len = 0
            Loop
            Line_Len = Dist
        Else
            If Draw_Flag = TRUE Then
                Thick_Line (x1, y1, x2, y2, thick,pcolor)
            End If
            Line_Len = Line_Len + Dist
        End If
    End If
End Sub

'-------- MAIN STARTS HERE ----------
Dim As Uinteger bckcolor = RGB(240,238,235)
ScreenRes 640, 480, 32
window (0,-200)-(10,200)
Paint (1,1), bckcolor

open cons for output as #99
        'print #99, "Viewport"
        'print #99, vx1, vy1, vx2, vy2



'Horiz Line
Dash_Line (1,0,9,0,10,rgb(255,0,0), 2)

For i as integer = 0 to 200
    Dash_Line (i/50+1, -100, (i+1)/50+1, -100, 10,rgb(0,0,255), 2)
next

'Vertical Line


For i as integer = 0 to 150
    Dash_Line (9, -i, 9, -(i+1), 10, rgb(0,0,255), 2)
next

Dash_Line (1, -150, 1, 150, 10, rgb(255,0,0), 2)

'Diagonal
Dash_Line (1,150, 9, -150, 10, RGB(255,0,0),2)

For i as integer = 0 to 200
    Dash_Line (i/25+1, i*(3/2)-150, (i+1)/25+1,(i+1)*(3/2)-150, 10, rgb(0,0,255),2)
next

'Sinewave
For i As Integer = 0 To 200
    Dash_Line (i*(8/200)+1, 100*Sin(i*6.28/80), (i+1)*(8/200)+1, 100*Sin((i+1)*6.28/80),20,rgb(0,0,0), 2)
Next

Sleep

 

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests