% 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