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