drawing 3D triangles by halves to create a sentinel/sentry game

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

drawing 3D triangles by halves to create a sentinel/sentry game

Post by parakeet »

Dear all,

This little game is an example of how to draw 3D triangles in a simpler manner : by splitting them in two halves, by the line that passes through the medium point. This is simpler because each half can be drawn by a very simple for y = up to down : draw horiz line : next y

BTW to play this sentinel, use cursor keys to look around
with your mouse point a square where you want to go
press R to create a robot there
still pointing at its square, press Q to transfers consciousness to it
you now the see your previous body that you can absorb with A. This gives you 3 energy points (see top-right of sreen)
you can also absorb trees, etc.
create boulders to place your next robot on them, so it will be higher
when higher you'll be able to see more squares, until you can see the sentinel's square
transfer into it and win

Code: Select all

'Sentinel simple, Anselme Dewavrin 2017 - adewavrin@gmail.com
'Feel free to use it, provided you mention my name.

const w              as integer = 640       'screen width
const h              as integer = 480       'screen height
const htitle         as integer  = h/20     'title zone height
const m              as double  = 100       'magnifier
const dfoc           as double  = 1024      '3D magnifier to make far objects look more or less small
const dtheta         as double  = 0.010     'horizontal rotation speed
const dphi           as double  = 0.010     'vertical rotation speed
const speedz         as double  = 10        'fall speed
const bh             as double  = .5        'boulders height
const rh             as double  = .8        'robot height
const PI             as double  = 3.1415927

const nbTreeFaces    as integer = 12
const nbBoulderFaces as integer = 10
const nbRobFaces     as integer = 22

dim as integer i, j
Dim Shared As double t(0 To 31, 0 To 31)  'checker heights array
Dim Shared as integer p(0 To 31, 0 To 31) 'elements array
dim as integer energy = 3
dim shared as double posx=m*18.5, posy=m*30.5, posz=m*10, theta=1.78, phi=-.15

type pt  'onscreen a point has two coords
    x as integer
    y as integer
end type

type face  'a 3D face is made of three summits and has a color
    ax as double : ay as double : az as double : bx as double : by as double : bz as double : cx as double : cy as double : cz as double : col as integer
end type

'3D objects in game are made of 3D faces
Dim Shared As face Tree(0 To nbTreeFaces-1),  Boulder(0 To nbBoulderFaces-1), Rob(0 to nbRobFaces-1)

sub ReadObj(F as face ptr, nbFaces as integer)
    dim k as integer
    for k = 0 to nbFaces-1
        read (F+k)->ax, (F+k)->ay, (F+k)->az, (F+k)->bx, (F+k)->by, (F+k)->bz, (F+k)->cx, (F+k)->cy, (F+k)->cz, (F+k)->col
    next k
end sub

'2D half triangle drawing
sub HalfTriangle (a as pt, by as integer, byval xl as integer, byval xr as integer, col as integer)
    dim as integer j
    for j=a.y to by step sgn(by-a.y)
        if j>= 0 and j<h then line (a.x + ((j-a.y)*(xl-a.x))/(by-a.y),j)-(a.x + ((j-a.y)*(xr-a.x))/(by-a.y),j), col
    next j
end sub

'2D triangle drawing
sub Triangle (byval a as pt, byval b as pt, byval c as pt, col as integer, coords as integer)
    if (b.x-a.x)*(c.y-a.y)-(b.y-a.y)*(c.x-a.x) < 0 then exit sub  'back face
    dim as pt p1=a, p2=b, p3=c
    if a.y > b.y then swap a, b   'sort y
    if b.y > c.y then swap b, c   'sort y
    if a.y > b.y then swap a, b   'sort y
    if a.y>=h or c.y<htitle or (a.x>=w and b.x>=w and c.x>=w) or (a.x<0 and b.x<0 and c.x<0) then exit sub 'out
    if a.y<>b.y then HalfTriangle(a, b.y, b.x, a.x+((b.y-a.y)*(c.x-a.x))/(c.y-a.y), col xor coords)
    if c.y<>b.y then HalfTriangle(c, b.y, b.x, a.x+((b.y-a.y)*(c.x-a.x))/(c.y-a.y), col xor coords)
    line (p1.x,p1.y)-(p2.x,p2.y), &h808080 xor coords : line (p1.x,p1.y)-(p3.x,p3.y), &h808080 xor coords
end sub

'3D rotation and projection
function ToScreen(byref p as pt, i as double, j as double, height as double) as integer
    dim as double x = i*m      - posx                   'translate
    dim as double y = j*m      - posy                   'translate
    dim as double z = height*m - posz                   'translate
    dim as double xprime = x*cos(-theta)-y*sin(-theta)  'rotz
    dim as double yprime = x*sin(-theta)+y*cos(-theta)  'rotz
    dim as double ysecond = yprime*cos(-phi)-z*sin(-phi)'roty
    dim as double zsecond = yprime*sin(-phi)+z*cos(-phi)'roty
    'ysecond+=m
    if ysecond<=0 then return 0                         'face is heading off
    p.x = w/2+ (dfoc*xprime) / ysecond                  'proj
    p.y = h/2- (dfoc*zsecond) / ysecond                 'proj
    return 1
end function

'draw a 3D object
sub DrawObj(Faces as face ptr, nbFaces as integer, dI as double, dJ as double, dH as double)
    dim k as integer, a as pt,b as pt,c as pt
    for k = 0 to nbFaces-1
        if ToScreen(a, dI+(Faces+k)->ax, dJ+(Faces+k)->ay, dH+(Faces+k)->az) and _
           ToScreen(b, dI+(Faces+k)->bx, dJ+(Faces+k)->by, dH+(Faces+k)->bz) and _
           ToScreen(c, dI+(Faces+k)->cx, dJ+(Faces+k)->cy, dH+(Faces+k)->cz) then Triangle(a,b,c, (Faces+k)->col, &h00)
    next k
end sub

'draw a checker square
sub square(iI as integer, iJ as integer)
    dim as double dI = cdbl(iI)
    dim as double dJ = cdbl(iJ)
    dim as pt a,b,c
    dim as integer col = &he000, coords
    if (iI and 1) xor (iJ and 1) then col = &h105030
    if t(iI, iJ) < t(iI+1, iJ) or t(iI, iJ) > t(iI, iJ+1) then  col = &hE0E0E0
    if t(iI, iJ) > t(iI+1, iJ) or t(iI, iJ) < t(iI, iJ+1) then  col = &h303030
    coords = (iI and 15) + ((iI and 16)shl 4) + ((iJ and 16) shl 5) + ((iJ and 15) shl 16)
    if ToScreen(a, dI,   dJ,   t(iI,   iJ)) and ToScreen(c, dI+1, dJ+1, t(iI+1, iJ+1)) then
       if ToScreen(b, dI+1, dJ,   t(iI+1, iJ))   then Triangle(b,a,c, col, coords)
       if ToScreen(b, dI,   dJ+1, t(iI,   iJ+1)) then Triangle(b,c,a, col, coords)
    endif
end sub

'draw a checker square object (trees...)
sub squareobject(iI as integer, iJ as integer)
    dim as double dI = cdbl(iI)
    dim as double dJ = cdbl(iJ)
    dim as integer i, n = (p(iI,iJ) and &hFF00) shr 8 'nb boulders
    'boulder tops
    for i = n-1 to 0 step -1 : DrawObj(@Boulder(nbBoulderFaces-2), 2, dI, dJ, t(iI,iJ)+i*bh) : next i
    'tree
    if (p(iI,iJ)and &hF) = 1 then DrawObj(@Tree(0), nbTreeFaces, dI, dJ, t(iI,iJ)+n*bh)
    'robot
    if (p(iI,iJ)and &hF) = 3 then DrawObj(@Rob(0), nbRobFaces, dI, dJ, t(iI,iJ)+n*bh)
    'boulders
    for i = 0 to n-1 : DrawObj(@Boulder(0), nbBoulderFaces-2, dI, dJ, t(iI,iJ)+i*bh) : next i
end sub

function isFlat(i as integer, j as integer) as integer
    if t(i, j) = t(i+1, j) and t(i, j) = t(i, j+1) and t(i, j) = t(i+1, j+1) then  return 1 else return 0
end function

'read fields
for i=0 to 31 : for j=0 to 31 : read t(i, j) : next j : next i 'heights
ReadObj(@Tree(0), nbTreeFaces)
ReadObj(@Boulder(0), nbBoulderFaces)
ReadObj(@Rob(0), nbRobFaces)
for i=0 to 5 : dim as integer ix, iy : read ix, iy : read p(ix, iy) : next i 'read elements pos

'main loop
screenres w, h, 32, 2
dim as integer activescreen=0
dim as integer winner=0
do
   screenset activescreen, 1-activescreen
   activescreen=1-activescreen

    dim as string myinkey = inkey$

    line (0,0)-(w-1,h-1),&h4FF, bf 'sky
    while theta > 2*PI : theta -= 2*PI : wend
    while theta < 0    : theta += 2*PI : wend
    'poorman's sort
    if theta>7*PI/4 or  theta<1*PI/4 then for j=30 to 0 step -1 : for i=30 to 0 step -1 : square(i,j) : next i: for i=30 to 0 step -1 : squareobject(i,j) : next i : next j
    if theta>1*PI/4 and theta<3*PI/4 then for i=0  to 30        : for j=0 to 30 : square(i,j) : next j : for j=0 to 30 : squareobject(i,j) : next j : next i
    if theta>3*PI/4 and theta<5*PI/4 then for j=0  to 30        : for i=0 to 30 : square(i,j) : next i : for i=0 to 30 : squareobject(i,j) : next i : next j
    if theta>5*PI/4 and theta<7*PI/4 then for i=30 to 0 step -1 : for j=0 to 30 : square(i,j) : next j : for j=0 to 30 : squareobject(i,j) : next j : next i

    'title and instructions
    line (0,0)-(w-1,htitle-1),&h0, bf

    'initial fall
    if posz > m*(t(int(posx/m), int(posy/m))+rh+((p(int(posx/m),int(posy/m)) and &hFF00) shr 8)) then posz -= speedz

    if winner = 1 then
        locate 1,2 : print "WINNER"
    else
        locate 1,2 : print "A:absorb - T:tree - B:boulder - R:robot - Q:Qteleport to robot - U:Uturn  e="; energy
        DIM mousex AS INTEGER, mousey AS INTEGER, mouseb AS INTEGER
        GETMOUSE mousex, mousey,, mouseb
        IF mousex >= 0 THEN
            dim as integer col = point(mousex,mousey)
            if 0=(col and &h400) then 'not sky
                i = (col and &hF) + ((col and &h100) shr 4)
                j = ((col and &hF0000) shr 16) + ((col and &h200) shr 5)
                if myinkey = "a" and p(i,j)<>0 and (i<>cint(posx)or j<>cint(posy)) then
                    dim as integer tree_or_robot = (p(i,j)and &hF)  'tree or robot are coded on low nibble
                    if tree_or_robot then
                        p(i,j) = p(i,j) and &hFF00
                        energy += tree_or_robot
                    else
                        if (p(i,j)and &hF00) then  'boulders are coded on msbyte
                            p(i,j) -= &h100 'absorb
                            energy += 2
                            endif
                        endif
                    endif
                IF myinkey = "t" and isFlat(i,j) and (p(i,j)and 15)=0 and energy >= 1 THEN p(i,j) += 1 : energy -= 1'tree
                IF myinkey = "b" and isFlat(i,j) and (p(i,j)and 15)=0 and energy >= 2 THEN p(i,j) += &h100 : energy -= 2 'boulder
                IF myinkey = "r" and isFlat(i,j) and (p(i,j)and 15)=0 and energy >= 3 THEN p(i,j) += 3 : energy -= 3 'rob
                IF myinkey = "q" and isFlat(i,j) and (p(i,j)and 15)=3 THEN 'transfer consciousness
                    posx = (i+.5)*m : posy = (j+.5)*m : posz = m*(t(i, j)+rh+(p(i,j) and &hFF00) shr 8) : theta += PI : phi = 0
                    if (i=7 and j=1) then winner=1
                endif
            endif
        endif
    endif
    
    if myinkey = "u"  then theta += PI
    If MULTIKEY(&h50) and phi>-1.26 Then phi   -= dphi    'down
    If MULTIKEY(&h48) and phi<1.26 Then phi   += dphi    'up
    If MULTIKEY(&h4B) Then theta += dtheta 'left
    If MULTIKEY(&h4D) Then theta -= dtheta 'right

loop while not MULTIKEY(&h01)

'land heights
data 0,1,1,1,0,0,2,2,2,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 1,1,1,1,0,0,2,2,2,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 1,1,1,1,0,0,2,2,2,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 0,0,0,0,0,0,2,2,2,0,0,0,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,5,5,4,4,1,1,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,5,5,4,4,1,1,1,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,6,6,4,4,1,1,1,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,6,6,4,4,1,1,1,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 0,0,0,0,0,2,2,2,0,0,0,0,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 1,1,1,1,0,2,2,2,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 1,1,1,1,0,2,2,2,0,3,3,3,3,3,3,3,3,3,3,3,3,3,3,0,2,2,0,1,1,0,0,0
data 1,1,1,1,0,2,2,2,0,3,3,3,3,3,3,3,3,3,3,3,3,3,3,0,2,2,0,1,1,0,0,0
data 1,1,1,1,0,2,2,2,0,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,1,1,1,0,0,0
data 1,1,1,1,0,2,2,2,0,3,3,3,0,1,1,1,2,2,2,2,2,2,2,2,2,2,1,1,1,0,0,0
data 1,1,1,1,0,2,2,2,0,3,3,3,0,1,1,1,2,2,2,2,2,2,2,2,2,2,1,1,1,0,0,0
data 0,0,0,0,0,2,2,2,0,0,0,0,0,1,1,1,2,2,2,2,2,2,2,2,2,2,1,1,1,0,0,0
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,2,2,2,2,2,2,2,2,2,2,1,1,1,0,0,0
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,2,2,2,2,2,2,2,2,2,2,1,1,1,0,0,0
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,0,0,0
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,0,0,0
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,0,0,0
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 2,2,2,2,0,0,0,0,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 0,0,0,0,0,2,2,2,0,0,0,0,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 1,1,1,1,0,2,2,2,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 1,1,1,1,0,2,2,2,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1
data 1,1,1,1,0,2,2,2,0,3,3,3,0,1,1,1,3,3,3,3,3,3,3,0,2,2,0,1,1,1,1,1

'tree
data .6, .5, 0,  .5, .4,  0,   .57, .43, .5,  &h7000
data .5, .6, 0,  .6, .5,  0,   .57, .57, .5,  &h7000
data .4, .5, 0,  .5, .6,  0,   .43, .57, .5,  &h7000
data .5, .4, 0,  .4, .5,  0,   .43, .43, .5,  &h7000
data .6, .5, 0,  .57, .43, .5, .57, .57, .5,  &h9000
data .5, .6, 0,  .57, .57, .5, .43, .57, .5,  &h9000
data .4, .5, 0,  .43, .57, .5, .43, .43, .5,  &h9000
data .5, .4, 0,  .43, .43, .5, .57, .43, .5,  &h9000
data .9, .5, .5, .5, .1,  .5,  .5,  .5, 1.5,  &h7000
data .5, .9, .5, .9, .5,  .5,  .5,  .5, 1.5,  &h7000
data .1, .5, .5, .5, .9,  .5,  .5,  .5, 1.5,  &h7000
data .5, .1, .5, .1, .5,  .5,  .5,  .5, 1.5,  &h7000

'boulder
data 1, .5, 0,   .5, 0,  0,    .9,  .1, bh,   &h707070
data .5, 1, 0,   1,  .5,  0,   .9,  .9, bh,   &h707070
data 0, .5, 0,   .5, 1,  0,    .1,  .9, bh,   &h707070
data .5, 0, 0,   0,  .5,  0,   .1,  .1, bh,   &h707070
data 1, .5, 0,   .9, .1,  bh,  .9,  .9, bh,   &h909090
data .5, 1, 0,   .9, .9,  bh,  .1,  .9, bh,   &h909090
data 0, .5, 0,   .1, .9,  bh,  .1,  .1, bh,   &h909090
data .5, 0, 0,   .1, .1,  bh,  .9,  .1, bh,   &h909090
data .1, .1, bh,  .1, .9, bh,  .9,  .1, bh,   &hA0A0A0
data .9, .9, bh,  .9, .1, bh,  .1,  .9, bh,   &hA0A0A0

'robot
data .55, .5, 0,    .5, .45,  0,        .6,  .4, rh/2,    &h707000
data .5, .55, 0,    .55, .5,  0,        .6,  .6, rh/2,    &h707000
data .45, .5, 0,    .5, .55,  0,        .4,  .6, rh/2,    &h707000
data .5, .45, 0,    .45,.5,  0,         .4,  .4, rh/2,    &h707000
data .55, .5, 0,    .6, .4,  rh/2,      .6,  .6, rh/2,    &h909000
data .5, .55, 0,    .6, .6,  rh/2,      .4,  .6, rh/2,    &h909000
data .45, .5, 0,    .4, .6,  rh/2,      .4,  .4, rh/2,    &h909000
data .5, .45, 0,    .4, .4,  rh/2,      .6,  .4, rh/2,    &h909000
data .75, .5, rh/3,  .5, .25,  rh/3,    .6,  .4, 3*rh/4,  &h707000
data .5, .75, rh/3,  .75, .5,  rh/3,    .6,  .6, 3*rh/4,  &h707000
data .25, .5, rh/3,  .5, .75,  rh/3,    .4,  .6, 3*rh/4,  &h707000
data .5, .25, rh/3,  .25,.5,  rh/3,     .4,  .4, 3*rh/4,  &h707000
data .75, .5, rh/3,  .6, .4,  3*rh/4,   .6,  .6, 3*rh/4,  &h909000
data .5, .75, rh/3,  .6, .6,  3*rh/4,   .4,  .6, 3*rh/4,  &h909000
data .25, .5, rh/3,  .4, .6,  3*rh/4,   .4,  .4, 3*rh/4,  &h909000
data .5, .25, rh/3,  .4, .4,  3*rh/4,   .6,  .4, 3*rh/4,  &h909000
data .4,  .4, 3*rh/4, .4, .6, 3*rh/4,   .6,  .4, 3*rh/4,  &h909000
data .6,  .6, 3*rh/4, .6, .4, 3*rh/4,   .4,  .6, 3*rh/4,  &h909000
data .5, .45,  rh*.9, .55, .5, rh*.9,   .5,  0.5, 3*rh/4, &h707000
data .55, .5,  rh*.9, .5, .55, rh*.9,   .5,  0.5, 3*rh/4, &h707000
data .5, .55,  rh*.9, .45, .5, rh*.9,   .5,  0.5, 3*rh/4, &h707000
data .45, .5,  rh*.9, .5, .45, rh*.9,   .5,  0.5, 3*rh/4, &h707000

'object locations
data 21, 30, 1
data 22, 29, 1
data 20, 26, 1
data 1, 1, 1
data 18, 30, 3  'start robot
data 7, 1, 3    'sentinel
Last edited by parakeet on Dec 09, 2017 14:55, edited 1 time in total.
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: drawing 3D triangles by halves to create a sentinel/sentry game

Post by Boromir »

parakeet wrote: This little game is an example of how to draw 3D triangles in a simpler manner : by splitting them in two halves, by the line that passes through the medium point. This is simpler because each half can be drawn by a very simple for y = up to down : draw horiz line : next y
Nice work!
I've never played a game with mechanics like this before. It took me a while to figure out how to play but I did finally win.

I generally use this method for rasterization as well because it's simple and fast.
Post Reply