Microsoft Small Basic

Program Listing: LSL357

List Program

GraphicsWindow.Title = "Kazakhstan"
Init()
InitPolygon()
AddSun()
AddEagle()
AddPattern()
Sub FlipPolylinesAtBottom
_bottomY = _pY[1][1]
For _iPolyline = 1 To _nPolyline
_nV = Array.GetItemCount(_pX[_iPolyline])
For _iV = 1 To _nV
If _bottomY < _pY[_iPolyline][_iV] Then
_bottomY = _pY[_iPolyline][_iV]
EndIf
EndFor
EndFor
For _iPolyline = 1 To _nPolyline
_nV = Array.GetItemCount(_pX[_iPolyline])
For _iV = 1 To _nV
_pY[_iPolyline][_iV] = 2 * _bottomY - _pY[_iPolyline][_iV]
EndFor
EndFor
EndSub
Sub FlipPolylinesAtRight
_rightX = _pX[1][1]
For _iPolyline = 1 To _nPolyline
_nV = Array.GetItemCount(_pX[_iPolyline])
For _iV = 1 To _nV
If _rightX < _pX[_iPolyline][_iV] Then
_rightX = _pX[_iPolyline][_iV]
EndIf
EndFor
EndFor
For _iPolyline = 1 To _nPolyline
_nV = Array.GetItemCount(_pX[_iPolyline])
For _iV = 1 To _nV
_pX[_iPolyline][_iV] = 2 * _rightX - _pX[_iPolyline][_iV]
EndFor
EndFor
EndSub
Sub FlipPolylinesAtTop
_topY = _pY[1][1]
For _iPolyline = 1 To _nPolyline
_nV = Array.GetItemCount(_pX[_iPolyline])
For _iV = 1 To _nV
If _pY[_iPolyline][_iV] < _topY Then
_topY = _pY[_iPolyline][_iV]
EndIf
EndFor
EndFor
For _iPolyline = 1 To _nPolyline
_nV = Array.GetItemCount(_pX[_iPolyline])
For _iV = 1 To _nV
_pY[_iPolyline][_iV] = 2 * _topY - _pY[_iPolyline][_iV]
EndFor
EndFor
EndSub
Sub MovePolylines
For _iPolyline = 1 To _nPolyline
_nV = Array.GetItemCount(_pX[_iPolyline])
For _iV = 1 To _nV
_pX[_iPolyline][_iV] = _pX[_iPolyline][_iV] + deltaX
_pY[_iPolyline][_iV] = _pY[_iPolyline][_iV] + deltaY
EndFor
EndFor
EndSub
Sub Init
scale = 0.7 ' for patern design
offsetX = 0
offsetY = 0
scale = 3.0 ' for eagle head design
offsetX = 900
offsetY = 600
scale = 3.0 ' for eagle left wing design
offsetX = 1000
offsetY = 400
scale = 1.6 ' for eagle design
offsetX = 700
offsetY = 400
scale = 0.5 ' for whole flag
offsetX = 0
offsetY = 0
gw = scale * 2000
gh = scale * 1000
GraphicsWindow.Height = gh
GraphicsWindow.Width = gw
GraphicsWindow.BackgroundColor = "DeepSkyBlue"
centerX = 2000 / 2 + 90
centerY = 1000 / 2 - 80
sunDiameter = 276
amountOfRays = 32
distanceFromCenter = (276 + 15 + 30) / 2
lengthOfRays = 210 - distanceFromCenter
sunColor = "Gold"
EndSub
Sub ShowCoordinate
GraphicsWindow.MouseMove = OnMouseMove
EndSub
Sub OnMouseMove
_mx = Math.Round(GraphicsWindow.MouseX / scale + offsetX)
_my = Math.Round(GraphicsWindow.MouseY / scale + offsetY)
GraphicsWindow.Title = _mx + "," + _my
EndSub
Sub AddCenter
_x = "1=" + (2000 / 2 + 90) + ";2=60;3=60;4=180;"
_y = "1=" + (1000 / 2 - 80) + ";2=55;3=945;4=945;"
GraphicsWindow.PenColor = "Black"
GraphicsWindow.PenWidth = 1
GraphicsWindow.BrushColor = "Transparent"
_n = Array.GetItemCount(_x)
For _i = 1 To _n
_cross1 = Shapes.AddLine(-4, -4, 4, 4)
Shapes.Move(_cross1, scale * (_x[_i] - offsetX), scale * (_y[_i] - offsetY))
_cross2 = Shapes.AddLine(-4, 4, 4, -4)
Shapes.Move(_cross2, scale * (_x[_i] - offsetX), scale * (_y[_i] - offsetY))
EndFor
_r = "0=210;1=235;2=265;3=305;4=320;5=308;6=335;7=350;"
_n = Array.GetItemCount(_r)
For _i = 0 To _n - 1
_d = scale * _r[_i] * 2
_circleMark = Shapes.AddEllipse(_d, _d)
Shapes.Move(_circleMark, scale * (centerX - offsetX) - _d / 2, scale * (centerY - offsetY) - _d / 2)
EndFor
EndSub
Sub DrawGrid
GraphicsWindow.PenColor = "Navy"
GraphicsWindow.PenWidth = 1
For _x = 0 To gw Step scale * 100
GraphicsWindow.DrawLine(_x - scale * offsetX, 0 - scale * offsetY, _x - scale * offsetX, gh - 1 - scale * offsetY)
EndFor
For _y = 0 To gh Step scale * 100
GraphicsWindow.DrawLine(0 - scale * offsetX, _y - scale * offsetY, gw - 1 - scale * offsetX, _y - scale * offsetY)
EndFor
EndSub
Sub AddSun
_opacity = 100
_sunRadius = sunDiameter / 2
_angleStep = 360 / amountOfRays
_stepRadians = Math.GetRadians(_angleStep)
GraphicsWindow.BrushColor = sunColor
GraphicsWindow.PenColor = sunColor
GraphicsWindow.PenWidth = 0
_sunCircle = Shapes.AddEllipse(scale * sunDiameter, scale * sunDiameter)
Shapes.Move(_sunCircle, scale * (centerX - _sunRadius - offsetX), scale * (centerY - _sunRadius - offsetY))
Shapes.SetOpacity(_sunCircle, _opacity)
For _angle = 0 To 359 Step _angleStep
_radians = Math.GetRadians(_angle)
_x1 = scale * (centerX + Math.Cos(_radians - _stepRadians / 4) * distanceFromCenter - offsetX)
_y1 = scale * (centerY + Math.Sin(_radians - _stepRadians / 4) * distanceFromCenter - offsetY)
_x2 = scale * (centerX + Math.Cos(_radians + _stepRadians / 4) * distanceFromCenter - offsetX)
_y2 = scale * (centerY + Math.Sin(_radians + _stepRadians / 4) * distanceFromCenter - offsetY)
_X3 = scale * (centerX + Math.Cos(_radians) * (distanceFromCenter + lengthOfRays) - offsetX)
_Y3 = scale * (centerY + Math.Sin(_radians) * (distanceFromCenter + lengthOfRays) - offsetY)
_triangle[_angle] = Shapes.AddTriangle(_x1, _y1, _x2, _y2, _x3, _y3)
Shapes.SetOpacity(_triangle[_angle], _opacity)
_circleDiameter = Math.SquareRoot((_x2 - _x1) * (_x2 - _x1) + (_y2 - _y1) * (_y2 - _y1)) + 2
_circle[_angle] = Shapes.AddEllipse(_circleDiameter, _circleDiameter)
Shapes.Move(_circle[_angle], (_x1 + _x2) / 2 - _circleDiameter / 2, (_y1 + _y2) / 2 - _circleDiameter / 2)
Shapes.SetOpacity(_circle[_angle], _opacity)
EndFor
EndSub
Sub AddEagle
' eye
_x = scale * 1031
_y = scale * 721
_size = scale * 4
GraphicsWindow.BrushColor = sunColor
GraphicsWindow.FillEllipse(_x - _size / 2 - scale * offsetX, _y - _size / 2 - scale * offsetY, _size, _size)
' head
InitHead()
FillSplines()
' tail
InitTail()
FillSplines()
' left wing
InitLeftWing()
FillSplines()
' right wing
InitRightWing()
FillSplines()
EndSub
Sub AddPattern
' small hearts
InitSmallHeart()
FillSplines()
FlipPolylinesAtTop()
deltaX = 0
deltaY = 894
MovePolylines()
FillSplines()
FlipPolylinesAtRight()
FillSplines()
deltaY = -894
MovePolylines()
FlipPolylinesAtBottom()
FillSplines()
' large hearts
InitLargeHeart()
FillSplines()
deltaY = 350
MovePolylines()
FillSplines()
FlipPolylinesAtBottom()
FillSplines()
deltaY = -350
MovePolylines()
FillSplines()
FlipPolylinesAtRight()
FillSplines()
deltaY = 350
MovePolylines()
FillSplines()
FlipPolylinesAtTop()
FillSplines()
deltaY = -350
MovePolylines()
FillSplines()
' roles
InitRole()
FillSplines()
deltaX = 0
deltaY = 350
MovePolylines()
FillSplines()
MovePolylines()
FillSplines()
FlipPolylinesAtBottom()
FillSplines()
deltaY = -350
MovePolylines()
FillSplines()
MovePolylines()
FillSplines()
FlipPolylinesAtRight()
FillSplines()
deltaY = 350
MovePolylines()
FillSplines()
MovePolylines()
FillSplines()
FlipPolylinesAtTop()
FillSplines()
deltaY = -350
MovePolylines()
FillSplines()
MovePolylines()
FillSplines()
EndSub
' B-Spline Curve 0.3
' Small Basic version ported by Nonki Takahashi.
'
' History:
' 0.3 2014-03-12 Ported _Interpret() routine.
' 0.2 2014-03-12 Leading _ is added to each non user routine name.
' 0.1 2014-02-21 Created. (WWV142)
'
' Reference:
' [1] Steven Harrington, COMPUTER GRAPHICS A Programming Approach, McGraw-Hill, 1983
' * Numbers such as (8.1) in comment mean algorithm numbers in this book.
' Leading _ is added to non user routine name.
'
Sub FillSplines
Not = "True=False;False=True;"
MAX_NUMBER_OF_LINES = 20
MAX_SAMPLE_POINTS = 20
DFSIZE = MAX_NUMBER_OF_LINES * MAX_SAMPLE_POINTS * 4
free = 1
numberOfLines = 10
polygon = ""
polygon["bc"] = sunColor
nv = 0
For _iPolyline = 1 To _nPolyline
InitSample()
If ns = 1 Then
nv = nv + 1
polygon["x" + nv] = sx[1]
polygon["y" + nv] = sy[1]
Else
SetBSpline()
For i = 1 To 5
ax[i] = sx[i]
ay[i] = sy[i]
az[i] = 0
EndFor
StartBSpline()
For i = 6 To ns - 2
x = sx[i]
y = sy[i]
z = 0
CurveAbs3()
EndFor
x1 = sx[ns - 1]
y1 = sy[ns - 1]
z1 = 0
x2 = sx[ns]
y2 = sy[ns]
z2 = 0
EndBSpline()
start = 1
count = free - 1
GraphicsWindow.PenColor = "Black"
AddPolygon()
EndIf
'_Interpret()
free = 1
EndFor
If polygon["x1"] <> polygon["x" + nv] Or polygon["y1"] <> polygon["y" + nv] Then
nv = nv + 1
polygon["x" + nv] = polygon["x1"]
polygon["y" + nv] = polygon["y1"]
EndIf
FillPolygon()
EndSub ' FillSplines
Sub DrawPolygon
GraphicsWindow.PenColor = "Black"
GraphicsWindow.PenWidth = 1
n = 0
While polygon["x" + (n + 1)] <> ""
n = n + 1
If 2 <= n Then
GraphicsWindow.DrawLine(polygon["x" + (n - 1)], polygon["y" + (n - 1)], polygon["x" + n], polygon["y" + n])
EndIf
EndWhile
EndSub ' DrawPolygon
Sub AddPolygon
For nth = start To start + count - 1
_GetPoint() ' revised version
_x = Math.Floor(x)
_y = Math.Floor(y)
If op = 1 Or op = 2 Then
If nv = 0 Or (_x <> polygon["x" + nv] Or _y <> polygon["y" + nv]) Then
nv = nv + 1
polygon["x" + nv] = _x
polygon["y" + nv] = _y
EndIf
Else
msg = "Error: OP-code error " + op
_Error()
EndIf
EndFor
EndSub ' AddPolygon
Sub InitHead
' 7 <= number of sample points
_pX = ""
_pY = ""
_pX[1] = "1=1067;2=1061;3=1056;4=1051;5=1048;6=1043;7=1038;"
_pY[1] = "1=710;2=711;3=712;4=713;5=713;6=715;7=717;"
_pX[2] = "1=1038;2=1038;3=1037;4=1036;5=1031;6=1029;7=1027;"
_pY[2] = "1=717;2=719;3=722;4=725;5=726;6=726;7=724;"
_pX[3] = "1=1027;2=1026;3=1024;4=1021;5=1020;6=1019;7=1017;"
_pY[3] = "1=724;2=724;3=724;4=724;5=723;6=723;7=722;"
_pX[4] = "1=1017;2=1012;3=1010;4=1008;5=1006;6=1006;7=1005;"
_pY[4] = "1=722;2=724;3=726;4=730;5=734;6=739;7=744;"
_pX[5] = "1=1005;2=1006;3=1008;4=1010;5=1012;6=1014;7=1016;"
_pY[5] = "1=744;2=742;3=740;4=738;5=737;6=736;7=735;"
_pX[6] = "1=1014;2=1020;3=1026;4=1053;5=1083;6=1112;7=1115;8=1111;9=1082;10=1076;11=1072;"
_pY[6] = "1=741;2=738;3=736;4=733;5=734;6=735;7=734;8=732;9=731;10=731;11=728;"
_pX[7] = "1=1072;2=1070;3=1066;4=1063;5=1062;6=1057;7=1055;"
_pY[7] = "1=728;2=730;3=730;4=731;5=730;6=730;7=728;"
_pX[8] = "1=1062;"
_pY[8] = "1=720;"
_pX[9] = "1=1057;"
_pY[9] = "1=719;"
_nPolyline = Array.GetItemCount(_pX)
EndSub ' InitHead
Sub InitTail
' 7 <= number of sample points
_pX = ""
_pY = ""
_pX[1] = "1=1175;2=1175;3=1174;4=1172;5=1170;6=1167;7=1164;"
_pY[1] = "1=714;2=716;3=718;4=720;5=721;6=722;7=723;"
_pX[2] = "1=1166;2=1159;3=1132;4=1084;5=1069;6=1054;7=1048;8=1049;9=1059;10=1075;"
_pY[2] = "1=728;2=736;3=742;4=743;5=746;6=753;7=765;8=767;9=764;10=754;"
_pX[3] = "1=1075;2=1075;3=1075;4=1078;5=1084;6=1090;7=1095;"
_pY[3] = "1=754;2=759;3=764;4=770;5=764;6=759;7=753;"
_pX[4] = "1=1095;2=1095;3=1095;4=1096;5=1100;6=1110;7=1117;"
_pY[4] = "1=753;2=758;3=765;4=769;5=769;6=760;7=755;"
_pX[5] = "1=1117;2=1117;3=1117;4=1119;5=1126;6=1132;7=1136;"
_pY[5] = "1=755;2=760;3=765;4=768;5=767;6=760;7=754;"
_pX[6] = "1=1136;2=1138;3=1141;4=1146;5=1150;6=1154;7=1156;"
_pY[6] = "1=754;2=758;3=764;4=765;5=761;6=756;7=754;"
_pX[7] = "1=1156;2=1160;3=1162;4=1167;5=1171;6=1177;7=1181;"
_pY[7] = "1=754;2=756;3=759;4=761;5=759;6=750;7=746;"
_pX[8] = "1=1181;2=1182;3=1185;4=1189;5=1195;6=1198;7=1202;8=1209;9=1218;10=1221;11=1222;12=1223;"
_pY[8] = "1=746;2=751;3=754;4=755;5=748;6=739;7=741;8=745;9=746;10=741;11=733;12=728;"
_pX[9] = "1=1223;2=1229;3=1238;4=1246;5=1252;6=1255;7=1255;"
_pY[9] = "1=728;2=731;3=734;4=733;5=728;6=721;7=717;"
_pX[10] = "1=1255;2=1237;3=1216;4=1204;5=1195;6=1183;7=1175;"
_pY[10] = "1=717;2=716;3=713;4=712;5=712;6=712;7=714;"
_nPolyline = Array.GetItemCount(_pX)
EndSub ' InitTail
Sub InitLeftWing
' 7 <= number of sample points
_pX = ""
_pY = ""
_pX[1] = "1=1100;2=1084;3=1068;4=1054;5=1033;6=1021;7=1017;8=1017;"
_pY[1] = "1=654;2=670;3=689;4=698;5=707;6=712;7=718;8=720;"
_pX[2] = "1=1022;2=1030;3=1037;4=1051;5=1079;6=1096;7=1121;8=1153;9=1179;"
_pY[2] = "1=722;2=719;3=716;4=708;5=690;6=675;7=666;8=662;9=657;"
_pX[3] = "1=1179;2=1188;3=1200;4=1212;5=1225;6=1241;7=1259;"
_pY[3] = "1=657;2=646;3=637;4=629;5=622;6=614;7=604;"
_pX[4] = "1=1259;2=1265;3=1272;4=1288;5=1300;6=1317;7=1326;"
_pY[4] = "1=604;2=592;3=582;4=566;5=558;6=551;7=553;"
_pX[5] = "1=1326;2=1325;3=1324;4=1322;5=1320;6=1317;7=1313;"
_pY[5] = "1=553;2=557;3=561;4=565;5=569;6=574;7=579;"
_pX[6] = "1=1313;2=1316;3=1319;4=1321;5=1324;6=1327;7=1329;"
_pY[6] = "1=579;2=578;3=577;4=577;5=576;6=576;7=576;"
_pX[7] = "1=1329;2=1329;3=1327;4=1324;5=1322;6=1317;7=1314;"
_pY[7] = "1=576;2=582;3=585;4=588;5=590;6=594;7=597;"
_pX[8] = "1=1325;2=1322;3=1316;4=1310;5=1305;6=1300;7=1296;"
_pY[8] = "1=601;2=604;3=607;4=611;5=614;6=617;7=621;"
_pX[9] = "1=1303;2=1293;3=1287;4=1284;5=1285;6=1282;7=1275;8=1269;"
_pY[9] = "1=624;2=628;3=631;4=635;5=639;6=643;7=645;8=648;"
_pX[10] = "1=1274;2=1272;3=1270;4=1268;5=1266;6=1263;7=1260;"
_pY[10] = "1=653;2=656;3=657;4=657;5=658;6=658;7=658;"
_pX[11] = "1=1261;2=1254;3=1247;4=1241;5=1228;6=1218;7=1203;"
_pY[11] = "1=670;2=674;3=679;4=683;5=689;6=692;7=694;"
_pX[12] = "1=1203;2=1217;3=1231;4=1247;5=1255;6=1271;7=1285;"
_pY[12] = "1=694;2=695;3=694;4=690;5=687;6=680;7=671;"
_pX[13] = "1=1270;2=1277;3=1286;4=1303;5=1308;6=1306;7=1293;8=1287;"
_pY[13] = "1=663;2=659;3=657;4=656;5=654;6=652;7=650;8=649;"
_pX[14] = "1=1287;2=1300;3=1320;4=1324;5=1320;6=1307;7=1302;"
_pY[14] = "1=649;2=645;3=640;4=637;5=635;6=634;7=633;"
_pX[15] = "1=1302;2=1316;3=1336;4=1341;5=1339;6=1327;7=1323;"
_pY[15] = "1=633;2=628;3=621;4=617;5=614;6=615;7=613;"
_pX[16] = "1=1323;2=1337;3=1360;4=1367;5=1370;6=1365;7=1342;8=1337;"
_pY[16] = "1=613;2=603;3=588;4=579;5=568;6=568;7=581;8=579;"
_pX[17] = "1=1337;2=1356;3=1382;4=1394;5=1393;6=1387;7=1380;8=1361;9=1347;10=1339;"
_pY[17] = "1=579;2=562;3=536;4=520;5=517;6=514;7=519;8=539;9=551;10=554;"
_pX[18] = "1=1339;2=1352;3=1379;4=1388;5=1386;6=1379;7=1371;8=1346;9=1337;"
_pY[18] = "1=554;2=539;3=501;4=484;5=479;6=477;7=483;8=518;9=527;"
_pX[19] = "1=1337;2=1348;3=1354;4=1361;5=1360;6=1354;7=1348;8=1344;9=1336;10=1327;"
_pY[19] = "1=527;2=504;3=488;4=464;5=443;6=439;7=445;8=462;9=493;10=508;"
_pX[20] = "1=1327;2=1332;3=1331;4=1326;5=1321;6=1304;7=1281;8=1249;9=1199;10=1150;11=1100;"
_pY[20] = "1=508;2=481;3=463;4=459;5=462;6=516;7=556;8=593;9=629;10=647;11=654;"
_nPolyline = Array.GetItemCount(_pX)
EndSub ' InitLeftWing
Sub InitRightWing
' 7 <= number of sample points
_pX = ""
_pY = ""
_pX[1] = "1=1085;2=1044;3=1000;4=985;5=960;6=938;7=904;8=869;9=859;10=856;11=852;12=849;13=849;14=851;"
_pY[1] = "1=654;2=650;3=637;4=630;5=616;6=600;7=563;8=500;9=465;10=462;11=461;12=463;13=483;14=511;"
_pX[2] = "1=851;2=841;3=835;4=829;5=825;6=819;7=818;8=829;9=843;"
_pY[2] = "1=511;2=483;3=459;4=443;5=440;6=444;7=458;8=501;9=529;"
_pX[3] = "1=843;2=821;3=812;4=802;5=796;6=793;7=794;8=798;9=815;10=826;11=842;"
_pY[3] = "1=529;2=500;3=486;4=477;5=475;6=480;7=486;8=499;9=522;10=538;11=556;"
_pX[4] = "1=842;2=831;3=802;4=795;5=789;6=787;7=801;8=812;9=819;10=841;"
_pY[4] = "1=556;2=549;3=522;4=516;5=516;6=522;7=538;8=551;9=559;10=579;"
_pX[5] = "1=841;2=835;3=817;4=809;5=811;6=829;7=844;8=866;"
_pY[5] = "1=579;2=579;3=570;4=569;5=578;6=591;7=600;8=611;"
_pX[6] = "1=866;2=857;3=840;4=835;5=835;6=848;7=862;8=873;9=865;10=853;11=851;12=862;13=872;14=881;"
_pY[6] = "1=611;2=611;3=611;4=610;5=612;6=619;7=622;8=625;9=629;10=631;11=633;12=637;13=638;14=639;"
_pX[7] = "1=881;2=874;3=866;4=866;5=876;6=886;7=896;"
_pY[7] = "1=639;2=642;3=644;4=648;5=651;6=654;7=655;"
_pX[8] = "1=896;2=880;3=886;4=900;5=918;6=938;7=963;8=983;"
_pY[8] = "1=655;2=661;3=661;4=669;5=676;6=685;7=691;8=694;"
_pX[9] = "1=983;2=963;3=946;4=932;5=928;6=912;7=901;"
_pY[9] = "1=694;2=689;3=683;4=678;5=676;6=668;7=663;"
_pX[10] = "1=914;2=908;3=902;4=900;5=897;6=892;7=889;"
_pY[10] = "1=653;2=653;3=653;4=651;5=650;6=648;7=645;"
_pX[11] = "1=896;2=889;3=881;4=881;5=883;6=875;7=877;8=863;9=851;10=856;11=862;"
_pY[11] = "1=637;2=634;3=632;4=627;5=621;6=618;7=608;8=602;9=594;10=592;11=591;"
_pX[12] = "1=862;2=859;3=855;4=851;5=848;6=845;7=843;"
_pY[12] = "1=591;2=588;3=585;4=581;5=578;6=573;7=571;"
_pX[13] = "1=855;2=855;3=853;4=851;5=849;6=846;7=843;"
_pY[13] = "1=570;2=565;3=561;4=555;5=550;6=545;7=541;"
_pX[14] = "1=843;2=846;3=849;4=850;5=851;6=854;7=856;"
_pY[14] = "1=541;2=540;3=540;4=541;5=541;6=541;7=543;"
_pX[15] = "1=859;2=885;3=918;4=930;5=957;6=1001;7=1016;8=1054;9=1076;"
_pY[15] = "1=537;2=559;3=600;4=611;5=620;6=658;7=660;8=663;9=674;"
_nPolyline = Array.GetItemCount(_pX)
EndSub ' InitRightWing
Sub InitSmallHeart
' 7 <= number of sample points
_pX = ""
_pY = ""
_pX[1] = "1=120;2=119;3=111;4=102;5=103;6=107;7=113;8=118;9=120;"
_pY[1] = "1=120;2=114;3=96;4=74;5=69;6=66;7=70;8=76;9=84;"
_pX[2] = "1=120;2=117;3=107;4=96;5=91;6=94;7=103;8=108;9=110;"
_pY[2] = "1=60;2=55;3=52;4=57;5=72;6=81;7=99;8=112;9=120;"
_nPolyline = Array.GetItemCount(_pX)
EndSub ' InitSmallHeart
Sub InitLargeHeart
' 7 <= number of sample points
_pX = ""
_pY = ""
_pX[1] = "1=110;2=93;3=80;4=69;5=59;6=55;7=57;8=67;9=69;10=82;"
_pY[1] = "1=180;2=210;3=236;4=254;5=276;6=294;7=301;8=316;9=320;10=325;"
_pX[2] = "1=96;2=101;3=107;4=112;5=114;6=117;7=120;"
_pY[2] = "1=325;2=323;3=320;4=316;5=313;6=308;7=299;"
_pX[3] = "1=120;2=115;3=112;4=111;5=111;6=113;7=115;"
_pY[3] = "1=215;2=222;3=228;4=234;5=237;6=242;7=244;"
_pX[4] = "1=115;2=109;3=107;4=103;5=99;6=94;7=91;"
_pY[4] = "1=244;2=242;3=242;4=243;5=245;6=249;7=255;"
_pX[5] = "1=91;2=107;3=113;4=115;5=111;6=108;7=100;8=96;9=93;10=96;"
_pY[5] = "1=255;2=253;3=257;4=266;5=276;6=278;7=281;8=280;9=276;10=268;"
_pX[6] = "1=96;2=91;3=87;4=86;5=84;6=84;7=84;"
_pY[6] = "1=268;2=268;3=269;4=270;5=273;6=276;7=280;"
_pX[7] = "1=84;2=81;3=79;4=79;5=77;6=75;7=74;"
_pY[7] = "1=280;2=280;3=281;4=282;5=282;6=283;7=285;"
_pX[8] = "1=74;2=75;3=77;4=79;5=79;6=81;7=84;"
_pY[8] = "1=285;2=287;3=288;4=288;5=289;6=290;7=290;"
_pX[9] = "1=84;2=84;3=84;4=86;5=87;6=91;7=96;"
_pY[9] = "1=290;2=294;3=297;4=300;5=301;6=302;7=302;"
_pX[10] = "1=96;2=93;3=96;4=100;5=106;6=109;7=103;8=90;9=78;10=72;11=67;12=67;13=69;14=78;15=80;16=105;17=120;"
_pY[10] = "1=302;2=294;3=292;4=289;5=293;6=299;7=312;8=316;9=314;10=309;11=301;12=292;13=276;14=255;15=251;16=209;17=180;"
_nPolyline = Array.GetItemCount(_pX)
EndSub ' InitLargeHeart
Sub InitRole
' 7 <= number of sample points
_pX = ""
_pY = ""
_pX[1] = "1=60;2=64;3=66;4=62;5=57;6=60;7=67;"
_pY[1] = "1=55;2=63;3=74;4=95;5=118;6=134;7=142;"
_pX[2] = "1=67;2=65;3=63;4=60;5=59;6=57;7=56;"
_pY[2] = "1=142;2=143;3=144;4=145;5=146;6=148;7=150;"
_pX[3] = "1=103;2=107;3=114;4=115;5=118;6=120;7=120;"
_pY[3] = "1=150;2=146;3=139;4=137;5=132;6=126;7=120;"
_pX[4] = "1=110;2=110;3=105;4=89;5=77;6=69;7=71;8=76;9=81;10=87;11=91;12=93;13=95;14=91;15=86;"
_pY[4] = "1=120;2=127;3=137;4=145;5=140;6=126;7=118;8=111;9=108;10=107;11=108;12=111;13=116;14=122;15=122;"
_pX[5] = "1=86;2=85;3=85;4=85;5=86;6=86;7=87;"
_pY[5] = "1=122;2=121;3=119;4=118;5=117;6=116;7=115;"
_pX[6] = "1=87;2=85;3=83;4=81;5=80;6=79;7=79;"
_pY[6] = "1=115;2=114;3=115;4=117;5=118;6=120;7=123;"
_pX[7] = "1=79;2=78;3=77;4=76;5=75;6=74;7=74;"
_pY[7] = "1=123;2=123;3=124;4=124;5=125;6=126;7=127;"
_pX[8] = "1=74;2=74;3=75;4=76;5=77;6=78;7=79;"
_pY[8] = "1=127;2=127;3=128;4=129;5=130;6=131;7=131;"
_pX[9] = "1=79;2=79;3=80;4=81;5=83;6=85;7=87;"
_pY[9] = "1=131;2=134;3=135;4=137;5=138;6=140;7=139;"
_pX[10] = "1=87;2=86;3=86;4=85;5=85;6=85;7=86;"
_pY[10] = "1=139;2=138;3=137;4=136;5=135;6=133;7=132;"
_pX[11] = "1=86;2=92;3=96;4=100;5=103;6=100;7=97;8=92;9=85;10=79;11=73;"
_pY[11] = "1=132;2=131;3=130;4=127;5=116;6=106;7=102;8=98;9=96;10=98;11=103;"
_pX[12] = "1=73;2=74;3=75;4=77;5=79;6=82;7=86;"
_pY[12] = "1=103;2=99;3=94;4=92;5=90;6=89;7=89;"
_pX[13] = "1=86;2=85;3=84;4=82;5=80;6=78;7=76;"
_pY[13] = "1=89;2=88;3=85;4=84;5=84;6=84;7=85;"
_pX[14] = "1=76;2=77;3=77;4=78;5=79;6=81;7=82;"
_pY[14] = "1=85;2=82;3=81;4=80;5=79;6=79;7=79;"
_pX[15] = "1=82;2=82;3=81;4=80;5=79;6=77;7=76;"
_pY[15] = "1=79;2=78;3=76;4=75;5=74;6=74;7=75;"
_pX[16] = "1=76;2=76;3=75;4=74;5=72;6=67;7=60;"
_pY[16] = "1=75;2=71;3=67;4=64;5=61;6=58;7=55;"
_nPolyline = Array.GetItemCount(_pX)
EndSub ' InitRole
Sub _Error
TextWindow.WriteLine(msg)
TextWindow.Pause()
Program.End()
EndSub ' _Error
Sub InitSample
' param _iPolyline - index for polyline
ns = Array.GetItemCount(_pX[_iPolyline])
For is = 1 To ns
sx[is] = scale * (_pX[_iPolyline][is] - offsetX)
sy[is] = scale * (_pY[_iPolyline][is] - offsetY)
EndFor
GraphicsWindow.PenColor = "DarkOrange"
EndSub ' InitSample
Sub WaitClick
clicked = "False"
While Not[clicked]
Program.Delay(100)
EndWhile
EndSub ' WaitClick
Sub OnMouseDown
sx[i] = GraphicsWindow.MouseX
sy[i] = GraphicsWindow.MouseY
clicked = "True"
EndSub ' OnMouseDown
Sub Pause
TextWindow.Write(msg)
TextWindow.Read()
EndSub ' Pause
Sub Dump
b = firstBlend
name = "firstBlend"
DumpB()
b = secondBlend
name = "secondBlend"
DumpB()
b = blend
name = "blend"
DumpB()
b = nextToLastBlend
name = "nextToLastBlend"
DumpB()
b = lastBlend
name = "lastBlend"
DumpB()
EndSub ' Dump
Sub DumpB
sum = ""
For j = 1 To 4
For i = 1 To numberOfLines
sum[i] = sum[i] + b[j][i]
r[i] = Math.Round(b[j][i] * 100) / 100
EndFor
TextWindow.WriteLine(name+"["+j+"]="+r)
EndFor
For i = 1 To numberOfLines
sum[i] = Math.Round(sum[i] * 100) / 100
EndFor
TextWindow.WriteLine("sum="+sum)
EndSub ' DumpB
Sub _PutPoint
' (2.1) wirte a complete command to display file
' param op, x, y - command to be written
' global dfOp, dfX, dfY - display file
' global free - position to next null cell
' constant DFSIZE - length of display file array
If DFSIZE < free Then
msg = "Error: Display file full"
_Error()
Else
dfOp[free] = op
dfX[free] = x
dfY[free] = y
free = free + 1
EndIf
EndSub ' _PutPoint
Sub _GetPoint
' (2.2 revised) Read Nth Command from Display File
' param nth - address of command to read
' return op, x, y - command to be read
' global dfOp, dfX, dfY - display file
op = dfOp[nth]
x = dfX[nth]
y = dfY[nth]
EndSub ' _GetPoint
Sub _DisplayFileEnter
' (2.3) create a command combined with operation and pen position and save it to display file
' param op - operation to be filed
' global dfPenX, dfPenY - current position of pen
x = dfPenX
y = dfPenY
_PutPoint()
EndSub ' _DisplayFileEnter
Sub _DoMove
' (2.8 revised) Execute to Move Pen
' param x, y - point for pen moving to
' global framePenX, framePenY - point (screen co-ordinate)
framePenX = x
framePenY = y
EndSub ' _DoMove
Sub _DoLine
' (2.9 revised) Execute to Draw Line
' param x, y - point for pen moving to
' global framePenX, framePenY - point (screen co-ordinate)
GraphicsWindow.DrawLine(framePenX, framePenY, x, y)
framePenX = x
framePenY = y
EndSub ' _DoLine
Sub MoveAbs3
' (8.1) 3-dimensional absolute move
' param x, y, z - target co-ordinate for pen move
' global dfPenX, dfPenY, dfPenZ - current pen position
dfPenX = x
dfPenY = y
dfPenZ = z
op = 1
_DisplayFileEnter()
EndSub ' _MoveAbs3
Sub LineAbs3
' (8.3) 3-dimensional absolute line draw
' param x, y, z - target co-ordinate draw line
' global dfPenX, dfPenY, dfPenZ - current pen position
dfPenX = x
dfPenY = y
dfPenZ = z
op = 2
_DisplayFileEnter()
EndSub ' _LineAbs3
Sub _MakeCurve
' (12.3) fill section of curve
' param b - array of blend function value
' global linesPerSection - number of lines per 1 curve section
' global xsm, ysm, zsm - 4-element array including sample points
' local i - stepping for 4 sample points
' local j - stepping for lines in curve section
' local x, y, z - co-ordinate of point on fitted curve
Stack.PushValue("local", i)
Stack.PushValue("local", j)
Stack.PushValue("local", x)
Stack.PushValue("local", y)
Stack.PushValue("local", z)
For j = 1 To linesPerSection
x = 0
y = 0
z = 0
' add contribution from each sample point
For i = 1 To 4
x = x + xsm[i] * b[i][j]
y = y + ysm[i] * b[i][j]
z = z + zsm[i] * b[i][j]
EndFor
' draw fitted curve
LineAbs3()
EndFor
z = Stack.PopValue("local")
y = Stack.PopValue("local")
x = Stack.PopValue("local")
j = Stack.PopValue("local")
i = Stack.PopValue("local")
EndSub ' _MakeCurve
Sub _NextSection
' (12.4) shift the sample points to prepare for the next curve section
' global xsm, ysm, zsm - 4-element array for sample points
' local i - stepping for sample points
Stack.PushValue("local", i)
For i = 1 To 3
xsm[i] = xsm[i + 1]
ysm[i] = ysm[i + 1]
zsm[i] = zsm[i + 1]
EndFor
i = Stack.PopValue("local")
EndSub ' _NextSection
Sub _PutInSM
' (12.6) put new sample point in xsm, ysm, zsm arrays
' param x, y, z - new sample point
' global xsm, ysm, zsm - 4-element arrays to keep sample points
xsm[4] = x
ysm[4] = y
zsm[4] = z
EndSub ' _PutInSM
Sub CurveAbs3
' (12.7) extend curve
' param x, y, z - new sample point for the curve
' global blend - array[4][linePerSection] for blend function value
_PutInSM()
b = blend
_MakeCurve()
_NextSection()
EndSub ' CurveAbs3
Sub SetBSpline
' (12.10) set number of lines in a section of B-spline interpolation
' param numberOfLines
' global linesPerSection - memory for numberOfLines
' global blend[][]
' global firstBlend[][]
' global nextToLastBlend[][]
' global lastBlend[][] - array[4][MAX_NUMBER_OF_LINES] to keep blending function value
' local i, j - stepping for points needed on the curve
' local u - temporary memory
Stack.PushValue("local", i)
Stack.PushValue("local", j)
Stack.PushValue("local", u)
If numberOfLines < 1 Or MAX_NUMBER_OF_LINES < numberOfLines Then
msg = "Error: Invalid number of line segments"
_Error()
EndIf
linesPerSection = numberOfLines
For i = 1 To numberOfLines
u = i / numberOfLines
firstBlend[1][i] = Math.Power(1 - u, 3)
firstBlend[4][i] = Math.Power(u, 3) / 6
firstBlend[3][i] = (3 / 2 - 11 * u / 12) * Math.Power(u, 2)
firstBlend[2][i] = 1 - firstBlend[1][i] - firstBlend[3][i] - firstBlend[4][i]
secondBlend[1][i] = firstBlend[1][i] / 4
secondBlend[4][i] = firstBlend[4][i]
secondBlend[3][i] = (((1 - u) * u + 1) * u + 1 / 3) / 2
secondBlend[2][i] = 1 - secondBlend[1][i] - secondBlend[3][i] - secondBlend[4][i]
blend[1][i] = firstBlend[1][i] / 6
blend[4][i] = firstBlend[4][i]
blend[3][i] = secondBlend[3][i]
blend[2][i] = 1 - blend[1][i] - blend[3][i] - blend[4][i]
j = numberOfLines - i
If 0 < j Then
nextToLastBlend[1][j] = secondBlend[4][i]
nextToLastBlend[2][j] = secondBlend[3][i]
nextToLastBlend[3][j] = secondBlend[2][i]
nextToLastBlend[4][j] = secondBlend[1][i]
lastBlend[1][j] = firstBlend[4][i]
lastBlend[2][j] = firstBlend[3][i]
lastBlend[3][j] = firstBlend[2][i]
lastBlend[4][j] = firstBlend[1][i]
EndIf
EndFor
nextToLastBlend[1][numberOfLines] = 0
nextToLastBlend[2][numberOfLines] = 1 / 6
nextToLastBlend[3][numberOfLines] = 7 / 12
nextToLastBlend[4][numberOfLines] = 1 / 4
lastBlend[1][numberOfLines] = 0
lastBlend[2][numberOfLines] = 0
lastBlend[3][numberOfLines] = 0
lastBlend[4][numberOfLines] = 1
u = Stack.PopValue("local")
j = Stack.PopValue("local")
i = Stack.PopValue("local")
EndSub ' SetBSpline
Sub StartBSpline
' (12.11) start B-spline interpolation curve
' param ax[], ay[], az[] - 5-element array to keep first 5 points
' global xsm, ysm, zsm - 4-element array for sample points
' global firstBlend
' global secondBlend - array[4][linesPerSection] to keep blending function value
' local i - stepping for sample points
Stack.PushValue("local", i)
For i = 1 To 4
xsm[i] = ax[i]
ysm[i] = ay[i]
zsm[i] = az[i]
EndFor
x = ax[1]
y = ay[1]
z = az[1]
MoveAbs3()
b = firstBlend
_MakeCurve()
_NextSection()
x = ax[5]
y = ay[5]
z = az[5]
_PutInSM()
b = secondBlend
_MakeCurve()
_NextSection()
i = Stack.PopValue("local")
EndSub ' StartBSpline
Sub EndBSpline
' (12.12) stop B-spline curve
' param x1, y1, z1 - previous sample point from the last
' param x2, y2, z2 - the last sample point
' global nextToLastBlend, lastBlend - array[4][linePerSection] of blend function value
x = x1
y = y1
z = z1
_PutInSM()
b = nextToLastBlend
_MakeCurve()
_NextSection()
x = x2
y = y2
z = z2
_PutInSM()
b = lastBlend
_MakeCurve()
EndSub ' EndBSpline
' Fill Polygon 0.2
' Small Basic version ported by Nonki Takahashi.
' Numbers such as (3.8) in comment mean algorithm numbers the book [1].
' Leading _ is added to non user routine name.
' This version neglects normalization co-ordinate, only uses screen co-ordinate.
'
' History:
' 0.2 2014-03-19 Created new interface. (NZT505-0)
' 0.1 2014-03-12 Created. (NZT505)
'
' Reference:
' [1] Steve Harington, COMPUTER GRAPHICS A Programming Aproach, McGraw-Hill, 1983
'
Sub InitPolygon
scanDecrement = 1
ROUNDOFF = Math.Power(10, -20)
free = 1
solid = "True"
EndSub
Sub FillPolygon
GraphicsWindow.BrushColor = polygon["bc"]
n = 0
ax = ""
ay = ""
While polygon["x" + (n + 1)] <> ""
n = n + 1
ax[n] = polygon["x" + n]
ay[n] = polygon["y" + n]
EndWhile
PolygonAbs2()
start = 1
count = 1
_Interpret()
free = 1
EndSub
Sub LineAbs2
' (2.5) Save Command to Draw Line
' param x, y - target co-ordinate to draw line
' global dfPenX, dfPenY - current pen position
dfPenX = x
dfPenY = y
op = 2
_DisplayFileEnter()
EndSub ' LineAbs2
Sub PolygonAbs2
' (3.1) Write Polygon to Display File
' param n - number of edges for the polygon
' param ax, ay - array of vertices for the polygon
' global dfPenX, dfPenY - current pen position
' local i - stepping across edges for the polygon
Stack.PushValue("local", i)
If n < 3 Then
msg = "Error: Polygon sides error"
_Error()
EndIf
op = n
dfPenX = ax[n]
dfPenY = ay[n]
_DisplayFileEnter()
For i = 1 To n
x = ax[i]
y = ay[i]
LineAbs2()
EndFor
i = Stack.PopValue("local")
EndSub ' PolygonAbs2
Sub _Interpret
' (3.6) Scan Display File and Execute Commands
' param start - first address to scan display file
' param count - number of commands to be executed
' local nth - address in display file
' local op, x, y - display file command
' loop to execute all commands needed
For nth = start To start + count - 1
_GetPoint() ' revised version
If op = 1 Then
_DoMove()
ElseIf op = 2 Then
_DoLine()
Else
index = nth
_DoPolygon()
nth = index
EndIf
EndFor
EndSub ' _Interpret
Sub _DoPolygon
' (3.7) Execute Polygon Command
If solid Then
_FillPolygon()
EndIf
_DoMove()
EndSub ' _DoPolygon
Sub _FillPolygon
' (3.8) Fill Polygon
' param op, x, y - polygon command
' param index - position of command in display file
' global yMax - maximum y array for each edge of the polygon
' global scanDecrement - displacement for scan line
' local edges - number of edges to process
' local scan - y co-ordinate of scan line
' local startEdge, endEdge - edges crossing the scan line
' load information about vertices of the polygon
_LoadPolygon() ' revised version
' enough edges to consider?
If edges < 2 Then
msg = "Waring: one or no edge"
TextWindow.WriteLine(msg)
Goto return
EndIf
' set scan line
scan = yMax[1]
' initialize the numbers for start and end edges to process
startEdge = 1
endEdge = 1
' fill polygon
' get a new edge included in scan step
lastEdge = edges
_Include()
' determine intersection point with scan line, and remove processed edge
_UpdateXValues()
' repeat until all edges are processed
While startEdge < endEdge
' fill scan line
_FillScan()
scan = scan - scanDecrement
_Include()
_UpdateXValues()
EndWhile
return:
EndSub ' _FillPolygon
Sub _LoadPolygon
' (3.9 revised) Read Information about Polygon Edges and Convert to the Screen Co-ordinate
' param op, x, y - polygon command
' param index - display file address for the command
' return edges - saved number of edges
' global widthStart, heightStart - address for start point of the screen
' global width, height - size of the screen
' constant ROUNDOFF - small number greater than any round-off error
' local x1, y1, x2, y2 - end points of the edge in actual screen co-ordinate
' local k - stepping across the edges of the polygon
' set start point for an edge
Stack.PushValue("local", j)
x1 = x
' adjust y co-ordinate to be at middle of the scan line
y1 = y + 0.5
' initialize the number of edges to save
edges = 0
' loop to get information of each edge
For k = index + 1 To index + op
' get next vertex
nth = k
Stack.PushValue("local", op)
_GetPoint() ' revised version
op = Stack.PopValue("local")
x2 = x
y2 = y + 0.5
' examine whether a horizontal line
If ROUNDOFF < Math.Abs(y1 - y2) Then
' increment saved number of edge data
edges = edges + 1
' save edge data in decending order of the y
j = edges
_PolyInsert()
EndIf
' old points are reset
x1 = x2
y1 = y2
EndFor
j = Stack.PopValue("local")
EndSub ' _LoadPolygon
Sub _PolyInsert
' (3.10) Sort and Write Edges Information of the Polygon
' param j - insert number
' param x1, y1, x2, y2 - both ends of the edge
' global yMax, yMin, xa, dx - arrays for edges information
' local j1 - stepping across the saved edges
' local yM - maximum y for new edge
' insert maximum y into sorted global arrays
j1 = j
' find maximum y
yM = Math.Max(y1, y2)
' find appropriate insert place and shift entries
While 1 < j1 And yMax[j1 - 1] < yM
yMax[j1] = yMax[j1 - 1]
yMin[j1] = yMin[j1 - 1]
xa[j1] = xa[j1 - 1]
dx[j1] = dx[j1 - 1]
j1 = j1 - 1
EndWHile
' insert edge information
yMax[j1] = yM
dx[j1] = (x2 - x1) / (y2 - y1)
If y2 < y1 Then
yMin[j1] = y2
xa[j1] = x1
Else
yMin[j1] = y1
xa[j1] = x2
EndIf
EndSub ' _PolyInsert
Sub _Include
' (3.11) include edges newly across with the scan line into consideration set
' param endEdge - current last element number
' param lastEdge - last edge number
' param scan - current position of the scan line
' global yMax, xa, dx - arrays for edges information
' local scanDecrement - displacement for the scan line
While endEdge <= lastEdge And scan <= yMax[endEdge]
' restore start point to last scan line position
xa[endEdge] = xa[endEdge] + dx[endEdge] * (scanDecrement + scan - yMax[endEdge])
' memory x displacement for a scan
dx[endEdge] = dx[endEdge] * -scanDecrement
endEdge = endEdge + 1
EndWhile
EndSub ' _Include
Sub _UpdateXValues
' (3.12) Update Intersection Points between Scan Line and the Edges
' param endEdge, startEdge - current limit in the list
' param scan - current scan line
' global yMin, xa, dx - arrays for edges information
' local k - stepping across edges
' local i - stepping across shifted up edges
Stack.PushValue("local", i)
For k = startEdge To endEdge - 1
If yMin[k] < scan Then
xa[k] = xa[k] + dx[k]
_XSort()
Else
startEdge = startEdge + 1
If startEdge <= k Then
For i = k To startEdge Step -1
yMin[i] = yMin[i - 1]
xa[i] = xa[i - 1]
dx[i] = dx[i - 1]
EndFor
EndIf
EndIf
EndFor
i = Stack.PopValue("local")
EndSub ' _UpdateXValues
Sub _XSort
' (3.13 revised) Check Order of X Co-ordinate for Intersection Points
' param startEdge - first number of considered edge
' param k - edge number to check the order
' global yMin, xa, dx - arrays of edges information
' local l - stepping across the edges
l = k
While startEdge < l And xa[l] < xa[l - 1]
_Exchange() ' revised version
l = l - 1
EndWhile
EndSub ' _XSort
Sub _Exchange
' (3.14 revised) Exchange Two Parameters
' param l - stepping across the edges
' global yMin, xa, dx - arrays of edges information
' local t - temporary memory
t = yMin[l]
yMin[l] = yMin[l - 1]
yMin[l - 1] = t
t = xa[l]
xa[l] = xa[l - 1]
xa[l - 1] = t
t = dx[l]
dx[l] = dx[l - 1]
dx[l - 1] = t
EndSub ' _Exchange
Sub _FillScan
' (3.15) Fill Scan Line
' param startEdge, endEdge - edges intersecting the scan line
' param scan - position of scan line
' global xa - array of intersection points between edges and the scan line
' local j - stepping across the edges
j = startEdge
While j < endEdge
x1 = xa[j]
x2 = xa[j + 1]
y = scan
_FillIn()
j = j + 2
EndWhile
EndSub ' _FillScan
Sub _FillIn
' Fill in the Given Horizontal Line
' param x1
' param x2
' param y
GraphicsWindow.FillRectangle(x1, y, x2 - x1 + 1, 1)
EndSub