Polygon demo

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Polygon demo

Post by BasicCoder2 »

Inspired by ircvs with his Landing gear demo using Turtle graphics.
Maybe a Turtle graphics version of this polygon demo is possible?

There are three kinds of objects: lines, circles and rotation points.
The lines need two points and the circles need one point plus a radius.
The rotation points are for the wheels. Their rotation is added to the rotation of the plane.
The line data for the wheels is found in the first 48 data statements below.
The plane's line's points data is around a center axis (0,0) but displaced to (mx,my) for display.
The wheels can also rotate around their own rotation points which change as the plane rotates.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255)
cls

'=========  MAKE A TEMPORARY IMAGE ===========
dim shared as any ptr temp
temp = imagecreate(640,480,rgb(255,255,255))
'=============================================

dim shared as double mx,my            'translation position of plane
mx = 320
my = 240   'set to center of window

dim shared as double px(400),py(400)  'initial positions
dim shared as double rx(400),ry(400)  'rotated points
dim shared as double cx(4),cy(4),r(4) 'initial positions of circles and radius
dim shared as double rcx(4),rcy(4)    'rotated position of circles
dim shared as integer lineCount
lineCount = 116
dim shared as double wx1,wy1,wx2,wy2      'rotation points of wheels
dim shared as double rwx1,rwy1,rwx2,rwy2  'rotated points
dim shared as double angle1,angle2        'two rotational angles of two wheels
dim shared as double wheelFlag
wheelFlag = 1
dim shared as double sizeOfPlane
sizeOfPlane = 1 '.5

angle1 = 0*DtoR
angle2 = 0*DtoR

wx1 = -70
wy1 = 12
wx2 = 70
wy2 = 12



sub Rotate(ww as double)  'ww = rotation of plane
    dim as double tx,ty  'temporary values
    
    ww = ww * DtoR
    
    'rotate line positions
    for i as integer = 0 to lineCount-1
        tx = Cos(ww) * px(i) - Sin(ww) * py(i)
        ty = Cos(ww) * py(i) + Sin(ww) * px(i)   
        rx(i) = tx
        ry(i) = ty
    next i
    
    'rotate circle positions
    for i as integer = 0 to 3
        tx = Cos(ww) * cx(i) - Sin(ww) * cy(i)
        ty = Cos(ww) * cy(i) + Sin(ww) * cx(i)   
        rcx(i) = tx
        rcy(i) = ty
    next i
    
    'rotate rotation points of wheels
    rwx1 = Cos(ww) * wx1 - Sin(ww) * wy1
    rwy1 = Cos(ww) * wy1 + Sin(ww) * wx1
    rwx2 = Cos(ww) * wx2 - Sin(ww) * wy2
    rwy2 = Cos(ww) * wy2 + Sin(ww) * wx2
    
    'rotate wheels around those points
    for i as integer = 0 to 23
        rx(i) = rx(i)-rwx1
        ry(i) = ry(i)-rwy1        
        tx = Cos(angle1) * rx(i) - Sin(angle1) * ry(i)
        ty = Cos(angle1) * ry(i) + Sin(angle1) * rx(i)
        rx(i) = tx
        ry(i) = ty
        rx(i) = rx(i) + rwx1
        ry(i) = ry(i) + rwy1
    next i

    for i as integer = 24 to 47
        rx(i) = rx(i)-rwx2
        ry(i) = ry(i)-rwy2        
        tx = Cos(angle2) * rx(i) - Sin(angle2) * ry(i)
        ty = Cos(angle2) * ry(i) + Sin(angle2) * rx(i)
        rx(i) = tx
        ry(i) = ty
        rx(i) = rx(i) + rwx2
        ry(i) = ry(i) + rwy2
    next i
    
end sub

sub drawPlane(sizeOfPlane as double,angle as double)
    rotate(angle)
    'clear temporary image
    line temp,(0,0)-(639,479),rgb(255,255,255),bf
    'draw lines at rotated positions
    for i as integer = 0 to 119 step 2
        line temp,(rx(i)*sizeOfPlane+mx,ry(i)*sizeOfPlane+my)-(rx(i+1)*sizeOfPlane+mx,ry(i+1)*sizeOfPlane+my),rgb(0,0,0)
    next i
    'draw circles at rotated positions
    for i as integer = 0 to 3  'draw 4 circles
        circle temp,(rcx(i)*sizeOfPlane+mx,rcy(i)*sizeOfPlane+my),r(i)*sizeOfPlane,rgb(0,0,0)
    next i
    paint temp,(1,1),rgb(255,0,255),rgb(0,0,0)  'add transparent color
    paint temp,(1,478),rgb(255,0,255),rgb(0,0,0)  'add transparent color
    'draw rotate rotation points of plane and wheels
    'circle temp,(rwx1*sizeOfPlane+mx,rwy1*sizeOfPlane+my),3,rgb(0,0,255)  'rotate wheels
    'circle temp,(rwx2*sizeOfPlane+mx,rwy2*sizeOfPlane+my),3,rgb(255,0,0)
    'circle temp,(0*sizeOfPlane+mx,0*sizeOfPlane+my),3,rgb(255,0,0)     'rotate plane
    screenlock()
    cls
    line (0,0)-(639,240),rgb(100,100,255),bf
    line (0,240)-(639,479),rgb(100,255,100),bf
    put (0,0),temp,trans
    screenunlock()
end sub



dim as integer x1,y1,x2,y2


'read line data
for i as integer = 0 to lineCount-1
    read px(i),py(i)
next i

'read circle data
for i as integer = 0 to 3  'draw 4 circles
    read cx(i),cy(i),r(i)
next i

dim as double angle
dim as string key
do
    key = inkey
    if key = "z" then
        angle = angle - 1
        if angle < 0 then angle = angle + 360
    end if
    if key = "x" then
        angle = angle + 1
        if angle >=360 then angle = angle - 360
    end if
    if key = "," then
        sizeOfPlane = sizeOfPlane + .01
    end if
    if key = "." then
        sizeOfPlane = sizeOfPlane - .01
    end if
    if key = "w" then
        my = my - 1
        if my<0 then my = 0
    end if
    if key = "s" then
        my = my + 1
        if my>479 then
            my = 479
        end if
    end if
    if key = "a" then
        mx = mx-1
        if mx<0 then mx = 0
    end if
    if key = "d" then
        mx = mx + 1
        if mx>639 then mx=639
    end if
    
        
    if key = " " then  'lift wheels
        if wheelFlag = 1 then
            angle1 = -90*DtoR
            angle2 = 90*DtoR
        else
            angle1 = 0*DtoR
            angle2 = 0*DtoR
        end if
        wheelFlag = -wheelFlag  'toggle flag
    end if
    
    drawPlane(sizeOfPlane,angle)   'sizeOfPlane = size and rotation

    locate 2,2
    print "sizeOfPlane is ";sizeOfPlane;"  Use keys [,] or [.] to change size"
    locate 4,2
    print "rotation of Plane ";angle;"  use keys [z] or [x]"
    locate 6,2
    print "up/down left/right use adws keys"
    locate 8,2
    print "toggle wheels up or down with space key"
    sleep 20
     
loop until multikey(&H01)
 
imagedestroy(temp)


DATA -83, 31 'wheels
DATA -75, 31
DATA -75, 31
DATA -75, 53
DATA -75, 53
DATA -83, 53
DATA -83, 53
DATA -83, 31

DATA -65, 31 
DATA -57, 31
DATA -57, 31
DATA -57, 53
DATA -57, 53
DATA -65, 53
DATA -65, 53
DATA -65, 31

DATA -73, 8   'left vertical wheel cylinder
DATA -67, 8
DATA -67, 8
DATA -67, 45
DATA -67, 45
DATA -73, 45
DATA -73, 45
DATA -73, 8

DATA  83, 31 
DATA  75, 31
DATA  75, 31
DATA  75, 53
DATA  75, 53
DATA  83, 53
DATA  83, 53
DATA  83, 31

DATA  65, 31 
DATA  57, 31
DATA  57, 31
DATA  57, 53
DATA  57, 53
DATA  65, 53
DATA  65, 53
DATA  65, 31



'DATA -50, 12  'wheel strut?
'DATA -67, 26

DATA  73, 8  'right vertical wheel cylinder
DATA  67, 8
DATA  67, 8
DATA  67, 45
DATA  67, 45
DATA  73, 45
DATA  73, 45
DATA  73, 8

'DATA  50, 12  'wheel strut?
'DATA  67, 26

DATA -35,-3   'left wing
DATA -31, 6
DATA  35,-3
DATA  31, 6
DATA -31, 6
DATA -30, 15
DATA  31, 6
DATA  30, 15
DATA -30, 15
DATA -320,-25

DATA  30, 15
DATA  320,-25
DATA -320,-25
DATA -320,-27
DATA  320,-25
DATA  320,-27
DATA -320,-27
DATA -35,-3
DATA  320,-27
DATA  35,-3
DATA -32,-37
DATA -116,-44
DATA  32,-37
DATA  116,-44
DATA -116,-44
DATA -116,-42
DATA  116,-44
DATA  116,-42
DATA -116,-42
DATA -37,-26
DATA  116,-42
DATA  37,-26
DATA -2,-34
DATA -2,-24
DATA  2,-34
DATA  2,-24
DATA -2,-24
DATA -27,-24
DATA  2,-24
DATA  27,-24
DATA -27,-24
DATA -20,-34
DATA  27,-24
DATA  20,-34
DATA -20,-34
DATA -2,-34
DATA  20,-34
DATA  2,-34
DATA -37, 14
DATA -35, 22
DATA  37, 14
DATA  35, 22
DATA -35, 22
DATA -30, 26
DATA  35, 22
DATA  30, 26
DATA -30, 26
DATA  0, 26
DATA  30, 26
DATA  0, 26
DATA -5,-55
DATA -2,-164
DATA -2,-164
DATA  3,-164
DATA  3,-164
DATA  6,-55
DATA  6,-55
DATA -5,-55

'data for circles, position and size
data -107,24,19  'left motor
data 107,24,19   'right motor
data 0,-16,39    'body
data 0,-1,17     'nose
Last edited by BasicCoder2 on Aug 19, 2014 0:50, edited 1 time in total.
Quark
Posts: 474
Joined: May 27, 2011 18:16
Location: Pennsylvania, U.S.
Contact:

Re: Polygon demo

Post by Quark »

.
Nice job, BasicCoder2! Slick plane. Liked the wheels action, which irrationally reminded me of a crab eating :)

How did you get the data lines? Hand-coded, or generated somehow?

Slight flicker from continually printing the instructions -- maybe put them in a routine and call after the screen has been updated?

I've also wondered about the turtle graphics and whether the draw lines could be generated from some draw program. If so, it would be a way to show images/drawings/plans via small programs. Or I could actually study ircvs' turtle work.

OK, I take it back about the crab :D
.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Polygon demo

Post by BasicCoder2 »

Quark wrote:.How did you get the data lines? Hand-coded, or generated somehow?
Both. The code below was the first effort and it evolved from there.

One method I have used is if you have a drawing of the polygon load the image and use the mouse to select lines with an automatic generation of coordinates as data statements (to post) or list array to save.

Code: Select all

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255)
cls

dim as integer n,x1,y1,x2,y2,sx,sy
read n
read x1,y1
sx = x1
sy = y1
for i as integer = 0 to n-2
    read x2,y2
    line (x1,y1)-(x2,y2),rgb(0,0,0)
    line (344-x1,y1)-(344-x2,y2),rgb(0,0,0)
    x1 = x2
    y1 = y2
    sleep
next i
line (x1,y1)-(sx,sy),rgb(0,0,0)
line (344-x1,y1)-(344-sx,sy),rgb(0,0,0)
    
    
read n
read x1,y1
sx = x1
sy = y1
for i as integer = 0 to n-2
    read x2,y2
    line (x1,y1)-(x2,y2),rgb(0,0,0)
    line (344-x1,y1)-(344-x2,y2),rgb(0,0,0)
    x1 = x2
    y1 = y2
    sleep
next i
line (x1,y1)-(sx,sy),rgb(0,0,0)
line (344-x1,y1)-(344-sx,sy),rgb(0,0,0)

read n
read x1,y1
sx = x1
sy = y1
for i as integer = 0 to n-2
    read x2,y2
    line (x1,y1)-(x2,y2),rgb(0,0,0)
    x1 = x2
    y1 = y2
    sleep
next i
line (x1,y1)-(sx,sy),rgb(0,0,0)

read n
read x1,y1
sx = x1
sy = y1
for i as integer = 0 to n-2
    read x2,y2
    line (x1,y1)-(x2,y2),rgb(0,0,0)
    line (344-x1,y1)-(344-x2,y2),rgb(0,0,0)
    x1 = x2
    y1 = y2
next i
line (x1,y1)-(sx,sy),rgb(0,0,0)
line (344-x1,y1)-(344-sx,sy),rgb(0,0,0)


circle (172,87),10,rgb(0,0,0)   'body of plane
circle (172,80),20,rgb(0,0,0)   'nose of plane
circle (115,102),11,rgb(0,0,0)  'engine left
circle (344-115,102),11,rgb(0,0,0) 'right engine
line (129,107)-(133,118),rgb(0,0,0),bf          'left/left wheel
line (344-129,107)-(344-133,118),rgb(0,0,0),bf
line (138,107)-(142,118),rgb(0,0,0),bf
line (344-138,107)-(344-142,118),rgb(0,0,0),bf
line (133,95)-(137,115),rgb(0,0,0),b  'hydraulics
line (344-133,95)-(344-137,115),rgb(0,0,0),b

line (0,118)-(639,118),rgb(0,0,0) 'ground

sleep

data 4,  2,74,   153,87, 155, 97,  1,75   'main wings

data 4, 171,71, 161,71, 157, 75,  171,75  'window

data 4, 170,60,  172,1,  174,1,  175,60  'tail

data 4, 156,70,  111,65,  111,67,  154,75 'back wings
I have edited the example in the first post to evolve it toward some kind of game maybe.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Polygon demo

Post by D.J.Peters »

funy your code gives me an error i never saw before.
fbc wrote:fbc -w all "t01.bas"
t01.asm: Assembler messages:
t01.asm:72: Error: `qword ptr [CX+eax*8]' is not a valid base/index expression
t01.asm:87: Error: `qword ptr [CX+eax*8]' is not a valid base/index expression
t01.asm:557: Error: `[CX+eax*8]' is not a valid base/index expression
As a workaround i renamed all cx vars to cx_ .

how ever it's a nice tiny program.

Joshy
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Polygon demo

Post by badidea »

I get the same assembly errors. Which indeed disappear with cx_ as variable.

FreeBASIC Compiler - Version 0.90.1 (07-17-2013) for linux
Post Reply