% Jethro Ma
% Turing Final Assignment
% Oct. 30, 2003
%setting the screen mode
setscreen ("graphics:vga")
%defining the variable types
type cone :
record
conetype : string
scoop, numtopping : int
price : real
flavour, topping : array 1 .. 3 of string
end record
type point2d :
record
x, y : int
end record
type point3d :
record
x, y, z : real
end record
type sprinkle :
record
spoint : point3d
epoint : point3d
epoint2d : point2d
spoint2d : point2d
sprinkle_col : int
end record
type scooprecord :
record
radius : int
pos : point2d
numtoppings : int
scoopcol : int
rsprinkle : array 1 .. 20 of sprinkle
chsprinkle : array 1 .. 20 of sprinkle
end record
%declaring the variables
var name : string %stores the user's name
var key : string (1) % used for getch(), to get a key from the user
%numcones is the number of cones
%linenum is a counter for recording the line number, used for drawing the bill
% choice is the number that the user chooses from the menus
% seecone is the cone number that the user wants to see
var numcones, linenum, choice, seecone : int
var tprice : real % the total price
var chosen : boolean
% used to determine if a topping has been chosen already for that cone.
%variables used in graphics
var cherry : point2d %the location of the cherry
var hascherry : boolean := false
%hascherry indicates the existence of a cherry, initialize hascherry to false.
var p2d : array 1 .. 5 of point2d %the 2D version of the pyramid's vertices
var p3d : array 1 .. 5 of point3d %the 3D version of the pyramid's vertices
var normal, vp, lsource, v1, v2, lv : point3d
%normal: normal of the view plane, the view point, the light source, v1 and v2 for calculation of normals, and vector of the light
var s_normal : array 1 .. 4 of point3d %the normals of the 4 surfaces
var u, k, cosv : real
%scalars, u: used for 3D to 2D conversion, k: distance of the viewplane from the origin.
var col : int %colour of the surfaces
var direction : real %direction to rotate the cone
%explanation of program
put
"Welcome to \"Irene's I Scream for Ice Cream Shop\". This program will help you purchase an ice cream. "
put ""
put "The user will decide:"
put ""
put "1. Number of cones"
put "2. The type of cone"
put "3. The number of scoops for each cone."
put "4. Flavour of cone."
put "5. The kind of topping."
put "***A plain cone with 1 scoop of any flavour and no toppings is $2.***"
put ""
%asking the user for his/her name. ': *' allows for multiple words
put "Hello. Please tell me your name."
get name : *
put "Good day, ", name, " . Feeling like you need an ice cream?"
%ask the user to continue
put "Press a key to continue."
getch (key)
cls
%ask the user for the number of cones
put
name,
", please enter the number of cones you want. The maximum number of cones you can get is 3."
%loop for foolproofing
loop
get numcones
%stop asking when the number of cones is from 1 - 3
exit when numcones > 0 and numcones <= 3
put "Sorry, the number of cones cannot be 0, negative, or more than 3. "
put
name,
", please enter the number of cones you want again. The maximum number of cones you can get is 3."
end loop
put name, ", so you want ", numcones, " cones!"
% declare thecones array to have numcones element with the type cone.
var thecones : array 1 .. numcones of cone
% erase/set all records in thecones to "" or 0. This is useful for drawing bill
% to display N/A when it is not chosen yet.
for c : 1 .. numcones
thecones (c).conetype := ""
thecones (c).scoop := 0
thecones (c).numtopping := 0
thecones (c).price := 2
for e : 1 .. 3
thecones (c).flavour (e) := ""
thecones (c).topping (e) := ""
end for
end for
%the procedure for drawing the bill on the screen
procedure tempbill
%set the total price to 0 first
tprice := 0
%loop through every cone
for c : 1 .. numcones
%record the row number in linenum and increase everytime a row is used
% so we can use the locate statement for the column adjustments
locate (15, c * 25 - 24)
linenum := 15
% display the cone #, increase linenum
colour (10)
put "Cone #", c
linenum += 1
% display the basic price, increase linenum
colour (9)
locate (linenum, c * 25 - 24)
put "Basic: $2.00"
linenum += 1
%display the cone type
locate (linenum, c * 25 - 24)
%if the cone type hasn't been chosen yet (empty), then display N/A.
if thecones (c).conetype = "" then
put "Cone Type: N/A"
%otherwise, display the cone type and the cost
else
case thecones (c).conetype of
label "Plain" :
put "Cone: Plain +$0.00"
label :
put "Cone: ", thecones (c).conetype,
" +$1.00"
end case
end if
linenum += 1
% display the scoops and flavours
locate (linenum, c * 25 - 24)
% if the number of scoops hasn't been chosen yet (0), then display N/A for
% scoops and flavours
if thecones (c).scoop = 0 then
put "Scoops: N/A"
linenum += 1
locate (linenum, c * 25 - 24)
put "Flavours: N/A"
linenum += 1
% otherwise, display the amount of scoop, and its cost, along with the flavours
else
put "Scoops: ", thecones (c).scoop, " +$", thecones (c).scoop *
0.75 - 0.75 : 0 : 2
linenum += 1
locate (linenum, c * 25 - 24)
put "Flavours:"
linenum += 1
%loop through each flavour
for s : 1 .. thecones (c).scoop
%only display when the flavour has been chosen, (not empty "")
if thecones (c).flavour (s) not= "" then
locate (linenum, c * 25 - 24)
put s, ": ", thecones (c).flavour (s)
linenum += 1
end if
end for
end if
% display the number of toppings
locate (linenum, c * 25 - 24)
put "Toppings: ", thecones (c).numtopping, " +$", thecones
(c).numtopping * 0.35 : 0 : 2
linenum += 1
%loop through each topping
for t : 1 .. thecones (c).numtopping
%display only if the topping is chosen (not empty "")
if thecones (c).topping (t) not= "" then
locate (linenum, c * 25 - 24)
put t, ": ", thecones (c).topping (t)
linenum += 1
end if
end for
% displaying the price
locate (linenum, c * 25 - 24)
put "Price "
linenum += 1
locate (linenum, c * 25 - 24)
linenum += 1
put "(plus tax): $", thecones (c).price : 0 : 2
% add the cone's price to tprice
tprice += thecones (c).price
linenum += 1
end for
%displaying the total price, tprice, of all cones.
colour (10)
locate (maxrow - 1, 1)
put "Total (plus tax): $", tprice : 0 : 2
colour (7)
end tempbill
cls
for c : 1 .. numcones
tempbill %display the current bill
%display the menu for the cone types
locate (1, 1)
put "Choices of the cone type:"
put "-------------------------"
put "1. Sugar (+ $1.00)"
put "2. Waffle (+ $1.00)"
put "3. Plain "
put ""
%ask for the cone type
put name, ", please enter the number for the cone type you want for"
put "cone #", c, ". Ex: 2 (for waffle)"
%foolproofing loop
loop
% get the user's choice
get choice
%stop asking when the choice is from 1 to 3.
exit when choice >= 1 and choice <= 3
%otherwise, display the red error message.
locate (7, 1)
colour (4)
put choice, " is not a valid choice!"
put name, ", please enter the number for the cone type you want for"
put "cone #", c, " again. Ex: 2 (for waffle)"
put " "
locate (10, 1)
colour (7)
end loop
%match the choice with the appropriate cone type, and store it in thecones(c).conetype
%increase the price of the cone
case choice of
label 1 :
thecones (c).conetype := "Sugar"
thecones (c).price += 1
label 2 :
thecones (c).conetype := "Waffle"
thecones (c).price += 1
label 3 :
thecones (c).conetype := "Plain"
end case
%output the user's choice.
put name, ", so you want a ", thecones (c).conetype, " cone!"
put ""
%ask the user to continue.
put "Press a key to continue and choose the number of"
put "scoops you want on cone #", c, "."
tempbill %display the current bill.
getch (key) %get a key from the user to move on
cls
tempbill %display the current bill.
locate (1, 1)
% Display the number of scoops and the price
put "Number of scoops"
put "-----------------"
put " 1 Scoop "
put " 2 Scoop (+ $0.75)"
put " 3 Scoop (+ $1.50)"
put ""
%ask the user for the number of scoops.
put name, ", please enter the amount of scoops you want on cone #", c
put "Only a maximum of three scoops is allowed."
%foolproofing loop
loop
%get the amount of scoops from the user.
get thecones (c).scoop
%stop asking when the user entered a valid scoop number from 1 to 3.
exit when thecones (c).scoop > 0 and thecones (c).scoop <= 3
locate (7, 1)
%otherwise, display the error message in red.
colour (4)
put thecones (c).scoop,
" was invalid! You must not enter 0, negative, or numbers more than 3!"
put name, ", please enter the amount of scoops you ant on cone #", c,
" again."
put "Only a maximum of 3 scoops is allowed."
put " "
locate (10, 1)
colour (7)
end loop
%increase the cone's price according to the number of scoops.
thecones (c).price += thecones (c).scoop * 0.75 - 0.75
%output the user's input.
put name, ", so you want ", thecones (c).scoop, " scoops on cone #", c,
"."
%ask the user to continue.
put "Press a key to continue and choose the flavours"
put "for your scoops."
tempbill %display the current bill.
getch (key) %get a key from the user to move on
cls
% loop through each scoop and ask for the corresponding flavour.
for s : 1 .. thecones (c).scoop
tempbill %display the current bill.
% Display the menu of flavours.
locate (1, 1)
put "Please choose from the following flavours!"
put "------------------------------------------"
put "1. Chocolate | 4. Mango | 7. Banana"
put "2. Vanilla | 5. Cappucino | 8. Lime"
put "3. Strawberry | 6. Blueberry |"
put ""
%ask for the flavour that the user wants.
put name, ", please enter the number for the flavour you want"
put "for scoop ", s, " . Ex: 4 (for Mango)"
%foolproofing loop
loop
%get the user's choice.
get choice
%stop asking when the choice is valid, from 1 to 8.
exit when choice >= 1 and choice <= 8
%otherwise display the red error messages.
colour (4)
locate (7, 1)
put choice, " is not a valid choice!"
put name, ", please enter the number for the flavour you want"
put "for scoop ", s, " again. Ex: 4 (for Mango)"
put " "
locate (10, 1)
colour (7)
end loop
%match the user's choice with a flavour, and record it in thecones(c).flavour .
case choice of
label 1 :
thecones (c).flavour (s) := "Chocolate"
label 2 :
thecones (c).flavour (s) := "Vanilla"
label 3 :
thecones (c).flavour (s) := "Strawberry"
label 4 :
thecones (c).flavour (s) := "Mango"
label 5 :
thecones (c).flavour (s) := "Cappucino"
label 6 :
thecones (c).flavour (s) := "Blueberry"
label 7 :
thecones (c).flavour (s) := "Banana"
label 8 :
thecones (c).flavour (s) := "Lime"
end case
%output the user's input.
put name, ", so you want ", thecones (c).flavour (s),
" for scoop #", s
%if this is the last flavour, then tell user to move on to toppings selection.
if s = thecones (c).scoop then
put
"Press a key to continue and choose the topping you want for cone #",
c
%otherwise, tell the user to continue choosing flavours.
else
put
"Press a key to continue and choose the flavour for scoop #",
s
+ 1
end if
tempbill %display the current bill.
getch (key) %get a key from the user to move on
cls
end for
%ask the user for # of toppings
loop
put name, ", how many toppings do you want on cone #",
c, "? (Maximum is 3)"
get thecones (c).numtopping %get the user's number of toppings
exit when thecones (c).numtopping >= 0 and thecones (c).numtopping
<= 3 %stop asking if the input is valid, from 0 to 3
%display error messages
put thecones (c).numtopping,
" is invalid! Negative, and numbers more than 3 are not allowed."
end loop
thecones (c).price += thecones (c).numtopping * 0.35
%increase price according to numtopping
put name, ", so you want ", thecones (c).numtopping, " toppings."
%output the input
put ""
if thecones (c).numtopping > 0 then %if user wants toppings...
put "Press a key to choose your toppings."
getch (key) %get a key from the user to move on
cls
%loop through each topping
for t : 1 .. thecones (c).numtopping
tempbill %display the current bill.
%display the menu of choices
locate (1, 1)
put "Toppings Available ($0.35 for each)"
put "----------------------------------"
put "1. Rainbow Sprinkles "
put "2. Chocolate Sprinkles"
put "3. Cherry"
put ""
%ask for the topping
put name, ", please enter the number for topping #", t
put "Ex: 3 (for Cherry)"
loop
get choice %get user's choice.
case choice of %match the user's choice with the topping.
label 1 :
thecones (c).topping (t) := "Rainbow Sprinkles"
label 2 :
thecones (c).topping (t) := "Chocolate Sprinkles"
label 3 :
thecones (c).topping (t) := "Cherry"
label :
end case
chosen := false %set chosen to false
for p : 1 .. t - 1 %checking for redundancy in topping
if thecones (c).topping (t) = thecones (c).topping (p)
then %if the topping is chosen
chosen := true %set chosen to true
end if
end for
exit when choice >= 1 and choice <= 3 and not chosen
%stop asking when the input is valid, and not chosen already.
%error messages.
locate (7, 1)
colour (4)
put choice, " is invalid or it has been chosen!"
put name, ", please enter the number for your topping #", t
put "Ex: 3 (for Cherry)"
put " "
colour (7)
locate (10, 1)
end loop
%output the input
put name, ", so you want ", thecones (c).topping (t),
" for topping #", t
put ""
if t = thecones (c).numtopping then %if it is the last topping...
if c = numcones then
% if it is the last cone, then tell the user to move on to see the final bill.
put "Press a key to see your bill for your cone(s)."
else %otherwise, continue with the next cone.
put "Press a key to choose the cone type for cone #", c
+ 1
end if
else
%if it's not the last topping, tell the user to move on and choose the next topping.
put "Press a key to continue and choose topping #", t + 1
end if
tempbill %display the current bill.
getch (key) %get a key from the user to move on
cls
end for
else % the user didn't want any toppings.
if c = numcones then
% if it is the last cone, tell the user to move on to see the final bill
put "Press a key to see your bill for your cone(s)."
else % otherwise, tell the user to continue to the next cone
put "Press a key to choose the cone type of cone #", c + 1
end if
getch (key) %get a key from the user to move on
cls
end if
end for
tempbill %display the current bill.
locate (maxrow, 1)
colour (10)
put "GST: $", tprice * 0.07 : 0 : 2 %display the GST
if tprice > 4 then
%if the final price is over $4, display and include the PST in the total.
put "PST: $", tprice * 0.08 : 0 : 2
put "Final Total: $", tprice * 1.15 : 0 : 2
else %no PST is needed in the total.
put "Final Total: $", tprice * 1.07 : 0 : 2
end if
colour (7)
put ""
%ask which cone the user wants to see.
put name,
", please pay your total and enter the number of the cone you want to see."
loop %fool proofing loop
put "CONE #" ..
get seecone %get the cone number from the user.
exit when seecone >= 1 and seecone <= numcones
%stop asking when it is valid.
%otherwise, display the error messages.
colour (4)
put "Cone #", seecone, " does not exist."
put "Please enter the number of the cone you want to see again."
colour (7)
end loop
put name, ", so you want to see cone #", seecone %output the input
% declare thescoops according to the number of scoops
var thescoops : array 1 .. thecones (seecone).scoop of scooprecord
setscreen ("graphics:m256") %change screen mode, so 256 colours are available
setscreen ("noecho") %don't allow the user's keys to be echoed.
randomize %using random numbers
for c : 1 .. 15
%set last 15 colours to shades from (RGB VALUES) (249,239,123) to (34,30,2)
setcolor (256 - c, round (249 - c * (249 - 34) / 15), round (239 - c *
(239 - 30) / 15), round (123 - c * (123 - 2) / 15))
end for
%procedure used to generate and store the sprinkles' locations.
procedure initsprinkles (var thesprinkles : array 1 .. 20 of sprinkle, t :
string, r : int)
%thesprinkles : the array of sprinkle to store to
%t: the type of sprinkle it is
%r: the radius of the scoop.
%declare variables used in this procedure
var randv, range, tdelta, posneg : int
%randv is the random value, range is the max./min. ranges for randint
%tdelta is the total change of position, and posneg determines a +ve or -ve value.
for c : 1 .. 20 %loop through each of the 20 sprinkles
tdelta := 5 %total change is 5px
randint (randv, - r, r)
%generating the x pos. of the starting point of the sprinkle
thesprinkles (c).spoint.x := randv %assign randv to spoint.x
%if thesprinkles(c).spoint.x already satisfy the x^2 + y^2 + z^2 = % r^2, then thesprinkles(c).spoint.y and thesprinkles(c).spoint.z
%can be 0.
if thesprinkles (c).spoint.x = - r or thesprinkles (c).spoint.x = r
then
thesprinkles (c).spoint.y := 0
thesprinkles (c).spoint.z := 0
else
%the maximum values for thesprinkles(c).spoint.y that satisfies x^ %2 + y^2 + z^2 = r^2
range := round (sqrt (r ** 2 - thesprinkles (c).spoint.x ** 2))
randint (randv, - range, range)
%generate the y value from -range to range.
thesprinkles (c).spoint.y := randv
%assign the randv to spoint's y.
%if thesprinkles(c).spoint.y already satisfies x^2 + y^2 + z^2 = r^2, then thesprinkles(c).spoint.z is 0.
if thesprinkles (c).spoint.y = - range or thesprinkles
(c).spoint.y = range then
thesprinkles (c).spoint.z := 0
else
%otherwise, z must be either -range or range, where range is the value z must be to satisfy x^2+y^2=r^2
range := round (sqrt (r ** 2 -
thesprinkles (c).spoint.x ** 2 - thesprinkles
(c).spoint.y ** 2))
randint (posneg, 0, 1)
thesprinkles (c).spoint.z := range * (posneg * 2 - 1)
end if
end if
%ending point
randint (randv, 0, tdelta) %the amount to change for x.
tdelta -= randv %decrease the change from total change
randint (posneg, 0, 1) %decide whether to take away or add to that x.
thesprinkles (c).epoint.x := thesprinkles (c).spoint.x + (posneg * 2
- 1) * randv %set epoint's x
randint (randv, 0, tdelta) %the amount to change for y.
tdelta -= randv %decrease the change from total change
randint (posneg, 0, 1) %decide whether to take away or add to that y.
thesprinkles (c).epoint.y := thesprinkles (c).spoint.y + (posneg * 2
- 1) * randv %set epoint's y
randint (posneg, 0, 1) %decide whether to take away or add to that y.
thesprinkles (c).epoint.z := thesprinkles (c).spoint.z + (posneg * 2
- 1) * tdelta %set epoint's z
if t = "Chocolate Sprinkles" then
%if the sprinkle is chocolate, the colour is brown
thesprinkles (c).sprinkle_col := 113
else %otherwise, the colour is randomized for rainbow sprinkles
randint (thesprinkles (c).sprinkle_col, 32, 103)
end if
end for
end initsprinkles
%procedure to initialize a 3D point or vector
procedure initpoint (var p : point3d, x : real, y : real, z : real)
p.x := x %set the point's x to x
p.y := y %set the point's y to y
p.z := z %set the point's z to z
end initpoint
%procedure to normalize a vector / change a vector into a unit vector
procedure normalize (var p : point3d)
var lengthv : real := sqrt (p.x ** 2 + p.y ** 2 + p.z ** 2)
%the magnitude of the vector
p.x := p.x / lengthv %divide p's x by p's magnitude
p.y := p.y / lengthv %divide p's y by p's magnitude
p.z := p.z / lengthv %divide p's z by p's magnitude
end normalize
%the function that returns the dot product of 2 vectors.
function dotproduct (p1 : point3d, p2 : point3d) : real
result p1.x * p2.x + p1.y * p2.y + p1.z * p2.z
end dotproduct
%the function that returns the cross product of 2 vectors.
function crossproduct (p1 : point3d, p2 : point3d) : point3d
var resultpoint : point3d
resultpoint.x := p1.y * p2.z - p1.z * p2.y
resultpoint.y := p1.z * p2.x - p1.x * p2.z
resultpoint.z := p1.x * p2.y - p1.y * p2.x
result resultpoint
end crossproduct
for a : 1 .. thecones (seecone).scoop
%the radius and the x & y positions depend on the scoop number
thescoops (a).radius := 35 - a * 5
thescoops (a).pos.y := 65 + a * 30
thescoops (a).pos.x := maxx div 2
%different colours for different flavours, store it in scoopcol
case thecones (seecone).flavour (a) of
label "Chocolate" :
thescoops (a).scoopcol := 6
label "Vanilla" :
thescoops (a).scoopcol := 31
label "Strawberry" :
thescoops (a).scoopcol := 84
label "Mango" :
thescoops (a).scoopcol := 66
label "Cappucino" :
thescoops (a).scoopcol := 90
label "Blueberry" :
thescoops (a).scoopcol := 56
label "Banana" :
thescoops (a).scoopcol := 92
label "Lime" :
thescoops (a).scoopcol := 96
end case
for c : 1 .. thecones (seecone).numtopping %check each topping
if thecones (seecone).topping (c) = "Cherry" then %if it's cherry..
if a = thecones (seecone).scoop then %if it's the last scoop
cherry.x := maxx div 2 %set the x position of the cherry
cherry.y := thescoops (a).pos.y + thescoops (a).radius + 5
%set the cherry's y pos. so it's on top of the last scoop
hascherry := true %there is a cherry
end if
elsif thecones (seecone).topping (c) = "Rainbow Sprinkles" then
%if it is rainbow sprinkles
initsprinkles (thescoops (a).rsprinkle, thecones
(seecone).topping (c), thescoops (a).radius)
%call the initsprinkles procedure
else
initsprinkles (thescoops (a).chsprinkle, thecones
(seecone).topping (c), thescoops (a).radius)
%call the initsprinkles procedure
end if
end for
end for
initpoint (normal, 0, 0, - 1) %the normal of the view plane
initpoint (lsource, 10, - 50, - 50) %position of the light source
initpoint (vp, 0, 100, - 600) %position of the view point
%co-ordinates of pyramid vertices in 3D space
initpoint (p3d (1), - 30, 0, - 30)
initpoint (p3d (2), 30, 0, - 30)
initpoint (p3d (4), - 30, 0, 30)
initpoint (p3d (3), 30, 0, 30)
initpoint (p3d (5), 0, - 80, 0)
%first face of prism
initpoint (v1, p3d (5).x - p3d (2).x, p3d (5).y - p3d (2).y, p3d (5).z - p3d
(2).z) %edge 1
initpoint (v2, p3d (1).x - p3d (2).x, p3d (1).y - p3d (2).y, p3d (1).z - p3d
(2).z) %edge 2
normalize (v1)
normalize (v2)
s_normal (1) := crossproduct (v1, v2) %calculating the normal of surface 1.
normalize (s_normal (1)) %normalize the normal of surface 1.
%second face
initpoint (v1, p3d (5).x - p3d (3).x, p3d (5).y - p3d (3).y, p3d (5).z - p3d
(3).z) %edge 1
initpoint (v2, p3d (2).x - p3d (3).x, p3d (2).y - p3d (3).y, p3d (2).z - p3d
(3).z) %edge 2
normalize (v2)
normalize (v1)
s_normal (2) := crossproduct (v1, v2) %calculating the normal of surface 2.
normalize (s_normal (2)) %normalize the normal of surface 2.
%third face
initpoint (v1, p3d (4).x - p3d (3).x, p3d (4).y - p3d (3).y, p3d (4).z - p3d
(3).z) %edge 1
initpoint (v2, p3d (5).x - p3d (3).x, p3d (5).y - p3d (3).y, p3d (5).z - p3d
(3).z) %edge 2
normalize (v1)
normalize (v2)
s_normal (3) := crossproduct (v1, v2) %calculating the normal of surface 3.
normalize (s_normal (3)) %normalize the normal of surface 3.
%fourth face
initpoint (v1, p3d (1).x - p3d (4).x, p3d (1).y - p3d (4).y, p3d (1).z - p3d
(4).z)
initpoint (v2, p3d (5).x - p3d (4).x, p3d (5).y - p3d (4).y, p3d (5).z - p3d
(4).z)
normalize (v1)
normalize (v2)
s_normal (4) := crossproduct (v1, v2) %calculating the normal of surface 4.
normalize (s_normal (4)) %normalize the normal of surface 4.
k := 0 %distance of view plane from the origin.
%the function that finds the intersection point between the viewpoint and the 3D point
%with the view plane
function pl_intersect (src_p : point3d) : point2d
var dest_p : point2d
var dir : point3d
initpoint (dir, vp.x - src_p.x, vp.y - src_p.y, vp
.z - src_p.z);
u := (k - (vp.x * normal.x + vp.y * normal.y + vp.z * normal.z)) /
(dir.x * normal.x + dir.y * normal.y + dir.z * normal.z)
dest_p.x := round (vp.x + u * dir.x)
dest_p.y := round (vp.y + u * dir.y)
result dest_p
end pl_intersect
%the procedure that converts all 3D points to 2D points
procedure f3dto2d
%loop throught the 5 vertices, convert them to 2D co-ordinates, and adjust the x and y
%so it appears in the appropriate place.
for c : 1 .. 5
p2d (c) := pl_intersect (p3d (c))
p2d (c).x += maxx div 2
p2d (c).y += 80
end for
for a : 1 .. thecones (seecone).scoop %loop through each scoop
for b : 1 .. thecones (seecone).numtopping %loop through each flavour
if thecones (seecone).topping (b) = "Rainbow Sprinkles" then
for c : 1 .. 20
thescoops (a).rsprinkle (c).spoint2d := pl_intersect
(thescoops (a).rsprinkle (c).spoint)
thescoops (a).rsprinkle (c).spoint2d.x += maxx div 2
thescoops (a).rsprinkle (c).spoint2d.y += thescoops
(a).pos.y
thescoops (a).rsprinkle (c).epoint2d := pl_intersect (
thescoops (a).rsprinkle (c).epoint)
thescoops (a).rsprinkle (c).epoint2d.x += maxx div 2
thescoops (a).rsprinkle (c).epoint2d.y += thescoops
(a).pos.y
end for
end if
%if the topping is chocolate sprinkles then...
if thecones (seecone).topping (b) = "Chocolate Sprinkles" then
for c : 1 .. 20 %loop through each sprinkle
%converting the starting point and ending point of the sprinkle to 2D and
%adjusting them to display appropriately.
thescoops (a).chsprinkle (c).spoint2d := pl_intersect
(thescoops (a).chsprinkle (c).spoint)
thescoops (a).chsprinkle (c).spoint2d.x += maxx div 2
thescoops (a).chsprinkle (c).spoint2d.y += thescoops
(a).pos.y
thescoops (a).chsprinkle (c).epoint2d := pl_intersect
(thescoops (a).chsprinkle (c).epoint)
thescoops (a).chsprinkle (c).epoint2d.x += maxx div 2
thescoops (a).chsprinkle (c).epoint2d.y += thescoops
(a).pos.y
end for
end if
end for
end for
end f3dto2d
%the procedure that draws the cone
procedure draw
%topx and top y store the vertices of the base of the pyramid
%for using in the drawfillpolygon procedure.
var topx, topy : array 1 .. 4 of int
for c : 1 .. 4
%store the vertices in the arrays topx and topy.
topx (c) := p2d (c).x
topy (c) := p2d (c).y
end for
%draw the base of pyramid
drawfillpolygon (topx, topy, 4, 8)
for a : 1 .. thecones (seecone).scoop %loop through each scoop
%draw the scoop
drawfilloval (thescoops (a).pos.x, thescoops (a).pos.y, thescoops
(a).radius + 5, thescoops (a).radius, thescoops (a).scoopcol)
%loop through each topping
for b : 1 .. thecones (seecone).numtopping
%if it isn't a cherry, then it's a sprinkle toping
if thecones (seecone).topping (b) not= "Cherry" then
for c : 1 .. 20 %loop through each sprinkle
%Rainbow sprinkles:
if thecones (seecone).topping (b) = "Rainbow Sprinkles"
then
%check to see if the sprinkle is facing the user by looking at the z values.
if thescoops (a).rsprinkle (c).spoint.z <= 0 and
thescoops (a).rsprinkle (c).epoint.z <= 0
then
%draw the sprinkle
drawline (thescoops (a).rsprinkle (c).spoint2d.x,
thescoops (a).rsprinkle (c).spoint2d.y,
thescoops
(a).rsprinkle (c).epoint2d.x, thescoops
(a).rsprinkle (c).epoint2d.y, thescoops
(a).rsprinkle (c).sprinkle_col)
end if
end if
%Chocolate sprinkles:
if thecones (seecone).topping (b) = "Chocolate Sprinkles"
then
%check to see if the sprinkle is facing the user by looking at the z values.
if thescoops (a).chsprinkle (c).spoint.z <= 0 and
thescoops (a).chsprinkle (c).epoint.z <= 0
then
%draw the sprinkle
drawline (thescoops (a).chsprinkle
(c).spoint2d.x,
thescoops (a).chsprinkle (c).spoint2d.y,
thescoops
(a).chsprinkle (c).epoint2d.x, thescoops
(a).chsprinkle (c).epoint2d.y, thescoops
(a).chsprinkle (c).sprinkle_col)
end if
end if
end for
end if
end for
end for
var vertex1, vertex2, vertex3 : point2d
%the three vertices to the surface
%arrays used to store the vertices for the drawfillpolygon procedure
var x, y : array 1 .. 3 of int
%loop through each surface of the pyramid.
for c : 1 .. 4
%calculate the light vector between the light source and a point on the surface.
initpoint (lv, lsource.x - p3d (c).x, lsource.y - p3d (c).y,
lsource.z - p3d (c).z)
%calculate the angle between the surface normal and the normal of the view plane.
%only draw the polygon if the angle is < 89 degrees, then
%calculate the angle (cosv) between the light vector and the surface vector
%to determine the shading.
if dotproduct (s_normal (c), normal) / (sqrt (s_normal (c).x **
2 + s_normal (c).y ** 2 + s_normal (c).z ** 2) * sqrt
(normal.x ** 2 + normal.y ** 2 + normal.z ** 2)) > 0.01
then
cosv := dotproduct (s_normal (c), lv) / (sqrt (s_normal
(c).x ** 2 + s_normal (c).y ** 2 + s_normal (c).z **
2)
* sqrt (lv.x ** 2 + lv.y ** 2 + lv.z ** 2))
if cosv >= 0 then
col := round (cosv * 15 + 242)
else %facing away from the light source (darkness)
col := 242
end if
%setting the 3 appropriate vertices for the polygon.
vertex1 := p2d (c)
vertex3 := p2d (5)
if c = 4 then
vertex2 := p2d (1)
else
vertex2 := p2d (c + 1)
end if
%recording the vertices in the x and y arrays for drawfillpolygon
x (1) := vertex1.x
y (1) := vertex1.y
x (2) := vertex2.x
y (2) := vertex2.y
x (3) := vertex3.x
y (3) := vertex3.y
drawfillpolygon (x, y, 3, col)
if thecones (seecone).conetype = "Waffle" then
%draw the vertical line
drawline (round ( (vertex1.x + vertex2.x) / 2),
round ( (vertex1.y + vertex2.y) / 2), vertex3.x,
vertex3.y, 242)
for i : 1 .. 3
%loop 3 times to draw the 3 horizontal lines
drawline (vertex1.x + round ( (vertex3.x - vertex1.x) /
4 * i), vertex1.y + round ( (vertex3.y
- vertex1.y) / 4 * i), vertex2.x +
round ( (vertex3.x - vertex2.x
) / 4 * i), vertex2.y + round (
(vertex3.y - vertex2.y) / 4
* i), 242)
end for
end if
end if
end for
%check if a cherry exists, and draw it if it exists.
if hascherry then
drawfilloval (round (cherry.x), round (cherry.y), 10, 10, 4)
end if
end draw
%the function that transform the 3D points rotating about the Y axis.
% src_p is the point to be transformed, deg is the degree of rotation.
% the Y transformation formulas:
% x' = cos(theta) * x + sin(theta) * z
% z' = -sin(theta) * x + cos(theta) * z
function transformY (src_p : point3d, deg : real) : point3d
var dest_p : point3d
dest_p.x := cosd (deg) * src_p.x + sind (deg) * src_p.z
dest_p.z := - (sind (deg) * src_p.x) + cosd (deg) * src_p.z
dest_p.y := src_p.y
result dest_p
end transformY
%the procedure for rotating all points about the Y axis.
procedure rotY (deg : real)
for c : 1 .. 5 %transform the vertices
p3d (c) := transformY (p3d (c), deg)
end for
for c : 1 .. 4 %transform the surface normals
s_normal (c) := transformY (s_normal (c), deg)
end for
%loop through the scoops
for a : 1 .. thecones (seecone).scoop
% loop through each topping
for b : 1 .. thecones (seecone).numtopping
%if the topping is rainbow sprinkles then
if thecones (seecone).topping (b) =
"Rainbow Sprinkles" then
for c : 1 .. 20 %loop through the sprinkles
%transforming the sprinkles
thescoops (a).rsprinkle (c).spoint := transformY
(thescoops (a).rsprinkle (c).spoint, deg)
thescoops (a).rsprinkle (c).epoint := transformY
(thescoops (a).rsprinkle (c).epoint, deg)
end for
end if
%if the topping is chocolate sprinkles then
if thecones (seecone).topping (b) =
"Chocolate Sprinkles" then
for c : 1 .. 20 %loop through the sprinkles
%transforming the sprinkles
thescoops (a).chsprinkle (c).spoint := transformY
(thescoops (a).chsprinkle (c).spoint, deg)
thescoops (a).chsprinkle (c).epoint := transformY
(thescoops (a).chsprinkle (c).epoint, deg)
end for
end if
end for
end for
end rotY
direction := 10 %default rotation degree is 10.
f3dto2d %transform all 3D points to 2D first
loop
%if the user pressed a key
if hasch then
%get the key from the user
getch (key)
%see what key it is
case ord (key (1)) of
%the ascii code for the left arrow key
label 203 :
direction := 10 %rotate clockwise
%the ascii code for the right arrow key
label 205 :
direction := - 10 %rotate counterclockwise
%the ascii code for escape key
label 27 :
exit %end the program
label :
end case
end if
put "'ESC' key to end"
put "Left/Right keys"
put "to rotate cone"
%rotate the points
rotY (direction)
%change the transformed 3D points to new 2D points
f3dto2d
%draw the cone
draw
delay (100) %wait 0.1 secs before rotate and re-draw
cls
end loop