Option explicit
option default none
const C_INSIDE = 0' 0000
const C_LEFT = 1 ' 0001
const C_RIGHT = 2 ' 0010
const C_BOTTOM = 4' 0100
const C_TOP = 8 ' 1000

cls
dim integer w = 266
dim integer h=w
dim integer wby2 = w\2
dim integer xm = 239
dim integer ym = 135
dim integer xmin = 106
dim integer xmax = xmin+w
dim integer ymin=2
dim integer ymax=w+ymin
dim integer xmn3=xm-3
dim integer xmn7=xm-7
dim integer xmn10=xm-10
dim integer xmn15=xm-15
dim integer xmn20=xm-20
dim integer xmn25=xm-25
dim integer xmn26=xm-26
dim integer xmn30=xm-30
dim integer xmp7=xm+7
dim integer xmp10=xm+10
dim integer xmp15=xm+15
dim integer xmp20=xm+20
dim integer xmp21=xm+21
dim integer xmp25=xm+25
dim integer xmp26=xm+26

dim integer ymn2=ym-2
dim integer ymn16=ym-16
dim integer ymn32=ym-32
dim integer ymn48=ym-48
dim integer ymn64=ym-64
dim integer ymp4=ym+4
dim integer ymp13=ym+13
dim integer ymp16=ym+16
dim integer ymp32=ym+32
dim integer ymp48=ym+48
dim integer ymp64=ym+64
dim integer ymp80=ym+80
dim integer ymp96=ym+96
dim integer ymp112=ym+112

dim integer radius = 101
dim integer ymmr16 = ym-radius+16
dim integer ymmrm16 = ym-radius-16
dim integer ymmr1 = ym-radius+1
dim integer ymmrm1 = ym-radius-1
dim integer rp20 = radius+20
dim integer rp10 = radius+10
dim integer rp15 = radius+15
dim integer rm20 = radius-20
dim integer xmnr = xm-radius
dim integer rgbw = rgb(white)
dim integer rgbb = rgb(black)
dim integer rgby = rgb(yellow)
dim integer rgbbr = rgb(brown)
dim integer rgbbl = rgb(blue)
SSD1963 1 'start showing page 2
pause 10
dim float pitch=0, roll=0
dim integer x0,y0,x1,y1,x2,y2
dim integer rx1(9),ry1(9),rx2(9),ry2(9),rcol(9)=(rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw)
dim float pitchperdegree=3.2
dim integer lx1(24)=(xmn26,xmn20,xmn26,xmp20,xmp26,xmp20,xmn15,xmn15,xmn15,xmn15,xmn15,xmn15,xmn25,xmn25,xmn25,xmn25,xmn25,xmp10,xmp 10,xmp10,xmp10,xmp10,xmp7,xm,xm)
dim integer ly1(24)=(ymp4,ymp4,ymp13,ymp4,ymp4,ymp13,ymp16,ymp48,ymp80,ymp112,ymn16,ymn48,ymn32,ymn64,ymp64,ymp32,ymp96,ymn32,ymn64, ymp64,ymp32,ymp96,ymmr16,ymmr1,ymmr1)
dim integer lx2(24)=(xmn26,xmn20,xmn20,xmp20,xmp26,xmp26,xmp15,xmp15,xmp15,xmp15,xmp15,xmp15,xmn10,xmn10,xmn10,xmn10,xmn10,xmp25,xmp 25,xmp25,xmp25,xmp25,xmn7,xmp7,xmn7)
dim integer ly2(24)=(ymp13,ymp13,ymp13,ymp13,ymp13,ymp13,ymp16,ymp48,ymp80,ymp112,ymn16,ymn48,ymn32,ymn64,ymp64,ymp32,ymp96,ymn32,ym n64,ymp64,ymp32,ymp96,ymmr16,ymmr16,ymmr16)
dim integer lcol(24)=(rgbb,rgbb,rgbb,rgbb,rgbb,rgbb,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw,rgbw, rgbb,rgbb,rgbb)
dim integer i

for pitch = -50 to 50 step 5
for roll = 0 to 360 step 2
drawAI(2)
ssd1963 2
pause 10
roll=roll+1
drawAI(1)
ssd1963 1
pause 10
next roll
for roll = 360 to 0 step -2
drawAI(2)
ssd1963 2
pause 10
roll=roll-1
drawAI(1)
ssd1963 1
pause 10
next roll
next pitch
end
'
sub drawAI(page as integer)
local float xf1,yf1,xf2,yf2, pitchoffset, rolloffset,yo1,yo2
local integer xi1,yi1,xi2,yi2,rgbtop,rgbbottom;
local integer offscreen,o = (page-1)*272
local float rroll=rad(roll)
if cos(rad(roll))>=0 then
rgbtop=rgbbl
rgbbottom=rgbbr
else
rgbtop=rgbbr
rgbbottom=rgbbl
endif
'
'sections which vary with pitch and roll
'
pitchoffset=pitch*pitchperdegree
rolloffset=wby2 * tan(rroll)
xf1=xmin
xf2=xmax
yf1=ym+pitchoffset+rolloffset:yo1=yf1
yf2=ym+pitchoffset-rolloffset:yo2=yf2
offscreen = CohenSutherlandLineClip(xf1,yf1,xf2,yf2)
xi1=fix(xf1):yi1=fix(yf1):xi2=fix(xf2):yi2=fix(yf2)
print
if NOT offscreen then
box xmin-2,0+o,w+4,h+4,2,rgbw,rgbtop
if yo2<yo1 then
if (xi1=xmin) and (xi2<>xmax) then
box xi1,yi1+o,w,ymax-yi1,0,,rgbbottom
box xi2,yi2+o,xmax-xi2,h,0,,rgbbottom
triangles(1,xi1,yi1+o,xi2,yi2+o,xi2,yi1+o,rgbbottom,0)
elseif (xi1=xmin) and (xi2=xmax) then
box xi1,yi1+o,w,ymax-yi1,0,,rgbbottom
triangles(1,xi1,yi1+o,xi2,yi2+o,xi2,yi1+o,rgbbottom,0)
elseif (xi1<>xmin) and (xi2=xmax) then
triangles(1,xi1,yi1+o,xi2,yi2+o,xi2,yi1+o,rgbbottom,0)
elseif (xi1<>xmin) and (xi2<>xmax) then
box xi2,yi2+o,xmax-xi2,h,0,,rgbbottom
triangles(1,xi1,yi1+o,xi2,yi2+o,xi2,yi1+o,rgbbottom,0)
endif
elseif yo1<yo2 then
if (xi1<>xmin) and (xi2=xmax) then
box xmin,yi2+o,w,ymax-yi2,0,,rgbbottom
box xmin,yi1+o,xi1-xmin,h,0,,rgbbottom
triangles(1,xi1,yi1+o,xi2,yi2+o,xi1,yi2+o,rgbbottom,0)
elseif (xi1=xmin) and (xi2=xmax) then
box xi1,yi2+o,w,ymax-yi2,0,,rgbbottom
triangles(1,xi1,yi1+o,xi2,yi2+o,xi1,yi2+o,rgbbottom,0)
elseif (xi1=xmin) and (xi2<>xmax) then
triangles(1,xi1,yi1+o,xi2,yi2+o,xi1,yi2+o,rgbbottom,0)
elseif (xi1<>xmin) and (xi2<>xmax) then
box xmin,yi1+o,xi1-xmin,h,0,,rgbbottom
triangles(1,xi1,yi1+o,xi2,yi2+o,xi1,yi2+o,rgbbottom,0)
endif
else
box xi1,yi1+o,w,ymax-yi1,0,,rgbbottom
endif
dcirch xm,ym+o,radius,rgbw,xmn30,ymp96+o,xmn30+60,ymp96+o+8
line xi1,yi1+o,xi2,yi2+o,,rgbw
else 'no useful information
if (offscreen and C_TOP) then
box xmin-2,0+o,w+4,h+4,2,rgbw,rgbtop
else
box xmin-2,0+o,w+4,h+4,2,rgbw,rgbbottom
endif
dcirch xm,ym+o,radius,rgbw,xmn30,ymp96+o,xmn30+60,ymp96+o+8
endif
'
' fixed background
'
text xm,ymn64+o,"20",CM,,,rgbw,1
text xm,ymn32+o,"10",CM,,,rgbw,1
text xm,ymp64+o,"20",CM,,,rgbw,1
text xm,ymp32+o,"10",CM,,,rgbw,1
text xm,ymp96+o,"30",CM,,,rgbw,1
triangles(1,xm,ymmr1+o,xmn7,ymmr16+o,xmp7,ymmr16+o,rgby,0)
BOX xmn3,ymn2+o,6,6,1,rgbb,rgby
BOX xmnr ,ymn2+o,rm20,6,1,rgbb,rgby
BOX xmp20 ,ymn2+o,rm20,6,1,rgbb,rgby
box xmn25,ymp4+o,4,8,0,,rgby
box xmp21,ymp4+o,4,8,0,,rgby
'
lines(25,lx1(),ly1(),lx2(),ly2(),lcol(),page)
'
' sections which vary with roll
'
rotxy(xm,ym,roll,xm,ymmrm1,x0,y0)
rotxy(xm,ym,roll,xmn7,ymmrm16,x1,y1)
rotxy(xm,ym,roll,xmp7,ymmrm16,x2,y2)
triangles(1,x0,y0+o,x1,y1+o,x2,y2+o,rgbw,0)
radial xm,ym,rp20,330-roll,radius,0
radial xm,ym,rp20,30-roll,radius,1
radial xm,ym,rp20,300-roll,radius,2
radial xm,ym,rp20,60-roll,radius,3
radial xm,ym,rp10,10-roll,radius,4
radial xm,ym,rp10,20-roll,radius,5
radial xm,ym,rp10,340-roll,radius,6
radial xm,ym,rp10,350-roll,radius,7
radial xm,ym,rp15,45-roll,radius,8
radial xm,ym,rp15,315-roll,radius,9
lines (10,rx1(),ry1(),rx2(),ry2(),rcol(),page)
ssd1963 page
pause 10 'needed to avoid flash on page switch
end sub
'
sub rotxy(xC as float, yC as float, angleD as float, x as float, y as float, xmaxot as integer, yrot as integer)
local float angle = rad(-angled)
local float s=sin(Angle),c=cos(Angle)
xmaxot = FIX(xC + c * (x - xC) - s * (y - yC))
yRot = FIX(yC + s * (x - xC) + c * (y - yC))
end sub
'
' Routine to draw a radial to a circle
' Parameters are:
' x-coordinate of centre of circle
' y-coordinate of centre of circle
' radius of circle
' radial of segment to be drawn (0-360 degrees)
' colour to draw segment
' inner radius for drawing radial lines, leave blank or set to zero if not required
'
Sub radial(x As integer, y As integer, o As integer, sr As integer, i as integer ,lpos as integer)
Local integer x1, x2, y1, y2
local float s=Sin(Rad(sr))
local float c=-Cos(Rad(sr))
rx2(lpos)=s*o + x
ry2(lpos)=c*o + y
rx1(lpos)=s*i + x 'i is 0 if not specified so a complete line from the centre is drawn
ry1(lpos)=c*i + y
End Sub
'
function CohenSutherlandLineClip(x0 as float, y0 as float, x1 as float, y1 as float) as integer
' compute outcodes for P0, P1, and whatever point lies outside the clip rectangle
local integer outcode0 = ComputeOutCode(x0, y0)
local integer outcode1 = ComputeOutCode(x1, y1)
local integer outcodeout
local float x,y
do while (1)
if (NOT(outcode0 OR outcode1)) then ' Bitwise OR is 0. Trivially accept and get out of loop
CohenSutherlandLineClip = 0
exit do
elseif (outcode0 AND outcode1) then 'Bitwise AND is not 0. Trivially reject and get out of loop
CohenSutherlandLineClip = (outcode0 AND outcode1)
exit do
else
' failed both tests, so calculate the line segment to clip
' from an outside point to an intersection with clip edge
' At least one endpoint is outside the clip rectangle; pick it.
if outcode0 then
outcodeOut = outcode0
else
outcodeOut = outcode1
endif
' Now find the intersection point;
' use formulas y = y0 + slope * (x - x0), x = x0 + (1 / slope) * (y - y0)
if (outcodeOut and C_TOP) then ' point is above the clip rectangle
x = x0 + (x1 - x0) * (ymax - y0) / (y1 - y0)
y = ymax
elseif (outcodeOut AND C_BOTTOM) then ' point is below the clip rectangle
x = x0 + (x1 - x0) * (ymin - y0) / (y1 - y0)
y = ymin
elseif (outcodeOut AND C_RIGHT) then ' point is to the right of clip rectangle
y = y0 + (y1 - y0) * (xmin - x0) / (x1 - x0)
x = xmax
elseif (outcodeOut AND C_LEFT) then' point is to the left of clip rectangle
y = y0 + (y1 - y0) * (xmax - x0) / (x1 - x0)
x = xmin
endif
' Now we move outside point to intersection point to clip
' and get ready for next pass.
if (outcodeOut = outcode0) then
x0 = x
y0 = y
outcode0 = ComputeOutCode(x0, y0)
else
x1 = x
y1 = y
outcode1 = ComputeOutCode(x1, y1)
endif
endif
loop
end function

function ComputeOutCode(x as float, y as float) as integer
ComputeOutCode = C_INSIDE ' initialised as being inside of clip window
if (x < xmin) then ' to the left of clip window
ComputeOutCode =ComputeOutCode OR C_LEFT
elseif (x > xmax) then ' to the right of clip window
ComputeOutCode =ComputeOutCode OR RIGHT
endif
if (y < ymin) then ' below the clip window
ComputeOutCode =ComputeOutCode OR C_BOTTOM
elseif (y > ymax) then ' above the clip window
ComputeOutCode =ComputeOutCode OR C_TOP
endif
end function
'
Csub lines
00000000
27BDFFC0 8FA30058 AFB70034 AFB60030 AFB5002C AFB20020 AFBF003C AFBE0038
AFB40028 AFB30024 AFB1001C AFB00018 8C730000 8C820004 00809021 2673FFFF
00131900 00139A00 00A0B821 00C0B021 00E0A821 1C400006 00739821 14400028
8FBF003C 8C820000 10400026 8FBE0038 00008021 00008821 3C149D00 241E0001
8FA30054 8FA70050 02F02021 00701021 8C420000 00F01821 02D02821 02B03021
8C670000 8CA50000 8C840000 8CC60000 AFBE0010 AFA20014 8E820050 02652821
0040F809 02673821 8E430004 26310001 001117C3 0043182A 1460FFE9 26100008
8E430004 14620006 8FBF003C 8E420000 0222202B 1480FFE3 8FA30054 8FBF003C
8FBE0038 8FB70034 8FB60030 8FB5002C 8FB40028 8FB30024 8FB20020 8FB1001C
8FB00018 03E00008 27BD0040
End Csub
'
Csub triangles 'draws multiple triangles with a delay between if required
00000000
27BDFF78 AFBF0084 AFBE0080 AFB7007C AFB60078 AFB50074 AFB40070 AFB3006C
AFB20068 AFB10064 AFB00060 AFA40088 8C820004 5C400007 AFA5002C 144000EB
8FBF0084 8C820000 104000E9 8FBE0080 AFA5002C 8FA20098 8FA3009C 8FA400A0
8FA500A4 AFA60030 AFA70034 AFA20038 AFA3003C AFA40040 AFA50044 AFA00028
3C159D00 8FA20030 8FA30038 8FA4002C 8C5E0000 8C630000 8FA50034 AFA30018
007E102A 8FA3003C 8C910000 8CB70000 8C630000 8FA40040 8FA50044 AFA30024
8C960000 10400007 8CB40000 03C01821 02201021 8FBE0018 02E08821 AFA30018
0040B821 8FA30018 02C3102A 10400007 8FA40018 02E01021 AFB60018 8FB70024
0060B021 AFA20024 8FA40018 009E102A 10400006 03C01821 02201021 0080F021
02E08821 AFA30018 0040B821 17D6001B 8FA30018 02F1102A 14400006 02203821
0237102A 10400005 8FA50024 10000002 02E03821 02E08821 8FA50024 00B1102A
54400003 8FB10024 00E5102A 00A2380B 8EA20048 AFB40010 00FE3821 8C420000
02202021 03C02821 02203021 0040F809 00F13823 10000066 8FA500A8 00761026
0002102B 00621023 AFA2001C 005E102A 14400030 03C08021 8FA50024 007E1023
02F12023 00B12823 02DEF823 AFBE0050 AFB70054 AFB60058 AFA40020 AFA50048
00009021 00009821 AFA2004C 00A0F021 0040B821 03E0B021 0277001A 02E001F4
8FA20020 02002821 02003821 02629821 26100001 00002012 00912021 00801021
0256001A 02C001F4 00003012 00D13021 00C4182A 10600003 025E9021 00C02021
00403021 8EA20048 AFB40010 8C420000 0040F809 00000000 8FA3001C 0070102A
1040FFE5 00000000 8FBE0050 8FB70054 8FB60058 02D0102A 1440002C 8FA20024
8FA50018 8FA40024 00511023 AFA20020 02C51023 AFA20018 8FA20020 00972023
021E9823 02059023 72449002 AFA4001C 02DEF023 70539802 8FA30018 8FA2001C
02002821 0243001A 006001F4 8FA30020 02003821 02429021 26100001 00002012
00972021 027E001A 03C001F4 02639821 00003012 00D13021 00C4182A 10600003
00801021 00C02021 00403021 8EA20048 AFB40010 8C420000 0040F809 00000000
02D0102A 1040FFE5 8FA30018 8FA500A8 8CA40000 8CA20004 00821025 50400005
8FA40028 8EA20004 0040F809 00000000 8FA40028 8FA5002C 8FA20088 24840001
24A50008 8C430004 AFA40028 000417C3 AFA5002C 8FA40030 8FA50034 0043182A
24840008 24A50008 AFA40030 AFA50034 8FA40038 8FA5003C 24840008 24A50008
AFA40038 AFA5003C 8FA40040 8FA50044 24840008 24A50008 AFA40040 AFA50044
1460FF30 8FA40028 8FA50088 8CA30004 14620006 8FBF0084 8CA20000 0082202B
1480FF29 8FA20030 8FBF0084 8FBE0080 8FB7007C 8FB60078 8FB50074 8FB40070
8FB3006C 8FB20068 8FB10064 8FB00060 03E00008 27BD0088
End Csub
'
CSub dcirch
00000000
27BDFFA0 AFB1003C AFB00038 AFBF005C AFBE0058 AFB70054 AFB60050 AFB5004C
AFB40048 AFB30044 AFB20040 8C840000 8FB00070 8FB10078 AFA4002C 8E020000
8CA50000 8CD20000 0082102A 8CF40000 14400010 AFA50018 8E220000 0044102A
1440000D 3C029D00 8FA20074 8C430000 02451021 0043182A 54600007 3C029D00
8FA4007C 8C830000 0062102A 10400015 8FA20074 3C029D00 8C420048 8FA30018
8FA4002C AFB40010 8C420000 02433821 00803021 0040F809 00E02821 8E020000
8FA4002C 0082102A 14400012 3C029D00 8E220000 0044102A 1440000E 3C029D00
8FA20074 8FA40018 8C430000 00921023 0043182A 54600007 3C029D00 8FA4007C
8C830000 0062102A 1040000C 8FA4002C 3C029D00 8C420048 8FA30018 AFB40010
8FA4002C 8C420000 00723823 00E02821 0040F809 00803021 8FA4002C 8E020000
02443021 00C2102A 14400011 3C029D00 8E220000 0046102A 1440000D 3C029D00
8FA30074 8FA40018 8C620000 0082102A 14400007 3C029D00 8FA3007C 8C620000
0044102A 1040000A 8FA4002C 3C029D00 8C420048 8FA50018 AFB40010 8C420000
00C02021 0040F809 00A03821 8FA4002C 8E020000 00923023 00C2102A 14400010
3C029D00 8E220000 0046102A 1440000C 3C029D00 8FA30074 8FA40018 8C620000
0082102A 14400006 3C029D00 8FA3007C 8C620000 0044102A 10400008 3C029D00
8C420048 8FA50018 AFB40010 8C420000 00C02021 0040F809 00A03821 1A40010F
24030001 00721823 00121023 00021040 AFA30024 8FA4002C 8FA3002C AFA20030
8FA20018 2484FFFF 24630001 AFA40020 2457FFFF 245E0001 AFA3001C AFA00028
3C159D00 8FA40024 04800006 8FA20030 2652FFFF 24420002 00822021 AFA20030
AFA40024 8E020000 8FA30028 8FB6001C 24630001 02C2102A 14400011 AFA30028
8E220000 0056102A 5440000E 8EA20048 8FA40074 8C830000 8FA40018 02441021
0043182A 54600007 8EA20048 8FA4007C 8C830000 0062102A 1040000B 8FA4002C
8EA20048 8FA30018 AFB40010 8C420000 02433821 02C02021 00E02821 0040F809
02C03021 8FA4002C 8E020000 02449821 0262102A 54400010 8EA20048 8E220000
0053102A 5440000C 8EA20048 8FA30074 8C620000 03C2102A 54400007 8EA20048
8FA4007C 8C820000 005E102A 5040000A 8E020000 8EA20048 AFB40010 02602021
8C420000 03C02821 02603021 0040F809 03C03821 8E020000 02C2102A 54400012
8EA20048 8E220000 0056102A 5440000E 8EA20048 8FA20074 8FA40018 8C430000
00921023 0043182A 54600007 8EA20048 8FA4007C 8C830000 0062102A 5040000B
8E020000 8EA20048 8FA30018 AFB40010 8C420000 00723823 02C02021 00E02821
0040F809 02C03021 8E020000 0262102A 54400010 8EA20048 8E220000 0053102A
5440000C 8EA20048 8FA40074 8C820000 02E2102A 54400007 8EA20048 8FA3007C
8C620000 0057102A 1040000A 8FA4002C 8EA20048 AFB40010 02602021 8C420000
02E02821 02603021 0040F809 02E03821 8FA4002C 8E020000 00929823 0262102A
54400010 8EA20048 8E220000 0053102A 5440000C 8EA20048 8FA30074 8C620000
03C2102A 54400007 8EA20048 8FA4007C 8C820000 005E102A 5040000A 8E020000
8EA20048 AFB40010 02602021 8C420000 03C02821 02603021 0040F809 03C03821
8E020000 8FB60020 02C2102A 54400012 8EA20048 8E220000 0056102A 5440000E
8EA20048 8FA20074 8FA40018 8C430000 02441021 0043182A 54600007 8EA20048
8FA4007C 8C830000 0062102A 5040000B 8E020000 8EA20048 8FA30018 AFB40010
8C420000 02433821 02C02021 00E02821 0040F809 02C03021 8E020000 0262102A
54400010 8EA20048 8E220000 0053102A 5440000C 8EA20048 8FA40074 8C820000
02E2102A 54400007 8EA20048 8FA3007C 8C620000 0057102A 5040000A 8E020000
8EA20048 AFB40010 02602021 8C420000 02E02821 02603021 0040F809 02E03821
8E020000 02C2102A 54400012 8EA20048 8E220000 0056102A 5440000E 8EA20048
8FA40074 8C830000 8FA40018 00921023 0043182A 54600007 8EA20048 8FA4007C
8C830000 0062102A 1040000B 8FA40028 8EA20048 8FA30018 AFB40010 8C420000
00723823 02C02021 00E02821 0040F809 02C03021 8FA40028 8FA30020 26F7FFFF
0092102A 8FA4001C 2463FFFF AFA30020 24840001 27DE0001 10400008 AFA4001C
8FA30028 8FA40024 00031040 24420001 00822021 1000FF03 AFA40024 8FBF005C
8FBE0058 8FB70054 8FB60050 8FB5004C 8FB40048 8FB30044 8FB20040 8FB1003C
8FB00038 03E00008 27BD0060
End CSub