setscreen ("graphics:vga")
setscreen ("cursor")
cls
const radius := 10
var x, y, xdir, ydir, speed : int
var bev, trev:int
x := maxx div 2
y := maxy div 2
xdir := 1
ydir := - 1
speed := 15
const adius := 10
var z, v, zdir, vdir, peed : int
z := maxx div 2
v := maxy div 2
zdir := - 1
vdir := 1
peed := 15
var w1 := 67
var q := 43
var dx := 9
var dy := 13
var e := 1
var r := 1
const margin := 20
var jim:int:=5
var jimmy:int:=6
var ter :int
for count:1..25000
delay (0)
randint (ter, 0, 15)
randint (jim, 1, maxx)
randint (jimmy, 1, maxy)
drawdot (jim, jimmy, ter)
end for
for n : 1 .. 25000
drawoval (w1, q, r, r, e)
if w1 >= maxx - margin or w1 < margin then
dx := - dx
r += 1
end if
if q >= maxy - margin or q < margin then
dy := - dy
end if
w1 += dx
q += dy
e := (e mod maxcolor) + 1 % e ranges from 1 to maxcolor
end for
for f: 1 .. 10000
var s, a, g : int
randint (s, 0, maxx - 20)
randint (a, 0, maxy - 70)
randint(g, 0, maxcolour)
drawfillbox (s, a, s + 20, a + 20, g)
end for
for i: 1 .. 10000
var o, u, p : int
randint (o, 0, maxx - 20)
randint (u, 0, maxy - 70)
randint (p, 1, maxcolor)
drawbox (o, u, o + 20, u + 20, p)
end for
/* Simple graphics demo
Ric Holt --- May 92
A stick with ends at (x1, y1) and (x2, y2) is bounced off the edges of
the screen. Vertical and horizontal reflections of the stick are drawn.
The stick's color is determined by its x1 location.
*/
setscreen ("nocursor")
var dx1 := 3
var dy1 := 4
var dx2 := 5
var dy2 := 6
var x1, y1, x2, y2 := 25
proc flipIfOutOfBounds (var delta : int, z, bound : int)
if z < 0 or z > bound then
delta := - delta
end if
end flipIfOutOfBounds
for i : 1 .. 25000
flipIfOutOfBounds (dx1, x1, maxx)
flipIfOutOfBounds (dy1, y1, maxy)
flipIfOutOfBounds (dx2, x2, maxx)
flipIfOutOfBounds (dy2, y2, maxy)
x1 += dx1
y1 += dy1
x2 += dx2
y2 += dy2
const Color := (x1 div 30) mod maxcolour + 1
drawline (x1, y1, x2, y2, Color)
drawline (maxx - x1, y1, maxx - x2, y2, Color)
drawline (x1, maxy - y1, x2, maxy - y2, Color)
drawline (maxx - x1, maxy - y1, maxx - x2, maxy - y2, Color)
end for
var theta := 0.
randomize
put "I'll bounce some stuff off the screen"
put "oooohhhh, look at all the pretty colours"
loop
randint (bev, 1, 15)
randint (trev, 1, 15)
theta := theta + 1
exit when theta > 40
drawbox (x, y, radius, radius, bev)
delay (40)
drawstar (x, y, radius, radius, trev)
x := x + xdir * speed
y := y + ydir * speed
if x + radius >= maxx then
x := maxx - radius
xdir := xdir * ( - 1)
elsif x - radius <= 0 then
x := 0 + radius
xdir := xdir * ( - 1)
end if
if y + radius >= maxy then
y := maxy - radius
ydir := ydir * ( - 1)
elsif y - radius <= 0 then
y := 0 + radius
ydir := ydir * ( - 1)
end if
drawoval (z, v, adius, adius, trev)
delay (40)
drawmapleleaf (z, v, adius, adius, bev)
z := z + zdir * peed
v := v + vdir * peed
if z + radius >= maxx then
z := maxx - adius
zdir := zdir * ( - 1)
elsif z - adius <= 0 then
z := 0 + adius
zdir := zdir * ( - 1)
end if
if v + adius >= maxy then
v := maxy - adius
vdir := vdir * ( - 1)
elsif v - adius <= 0 then
v := 0 + adius
vdir := vdir * ( - 1)
end if
exit when z = 33
end loop
put "This screen is to crowded, I'll clear it"
delay (1000)
cls
var ji:int := 0
var jimm:int:=0
var te: int:= 0
setscreen ("graphics:vga")
for count:1..25000
randint (ji, 1, maxy)
randint (jimm, 1, maxx)
randint (te, 1, 15)
drawdot (ji, jimm, te)
end for
delay (1000)
const gree:=9
colorback(9)
for row: 1..25
put repeat(" ",80)
end for
delay (500)
const magent:=5
color(magent)
setscreen ("nocursor")
var counter:int:=0
loop
var row:=13
var column:=30
var value: int:=1
loop
exit when column<1 or column>=80 or row<1 or row >=25
colorback (9)
cls
locate(row, column)
exit when column = 50
exit when column<1 or column>=80 or row<1 or row >=25
put chr(value)
randint(row, row-1, row+1)
randint (column, column-1, column+1)
end loop
counter:=counter + 1
play(">C<")
exit when counter = 3
end loop
put "Yawn, no effort"
put "Ready for whats next?"
var reply:string
get reply:*
var repl:string(1)
put "Thats all fine and dandy but are you sure your ready?"
getch (repl)
put "No time to talk, we must proceed"
delay (1000)
setscreen ("graphics")
var s, d, f:int
const centerx :=maxx div 2
const centery :=maxy div 2
randomize
var count:int :=0
loop
count := count + 1
randint (s, 0, maxx)
randint (d, 0, maxy)
randint (f, 0, maxcolor)
drawline (centerx, centery, s, d, f)
exit when count = 60000
end loop
setscreen ("graphics")
colorback (12)
cls
locate (25, 1)
delay (1000)
var colorno:int:=0
for bla: 1..253
randint (colorno, 0, 15)
color (colorno)
put chr(bla)..
delay (50)
end for
setscreen ("graphics")
palette (2)
const gee :=1
const maxradius:= 50
const xcenter := 11
const ycenter := 20
const teta := 60
put " "
put "Have you seen enough or do you still disbelieve in my magic?"
var answr:string(1)
getch (answr)
put "It matters not what your long winded opinion is mortal, now tell me, do you now believe. Yes or no?"
var anwer: string
get anwer:*
if anwer = "yes" then
put "Thankyou"
elsif anwer = "no" then
for radi:1..maxradius
drawarc (xcenter, ycenter, radi, radi, 0, teta, gee)
end for
put "You are as moldy as this cheese!"
elsif anwer > "yes" or anwer < "no" then
put "how dare you not answer my question!"
get anwer:*
if anwer = "yes" then
put "Thankyou"
elsif anwer = "no" then
for radi:1..maxradius
drawarc (xcenter, ycenter, radi, radi, 0, teta, gee)
end for
put "You are as moldy as this cheese!"
elsif anwer > "yes" or anwer < "no" then
put "how dare you not answer my question!"
get anwer:*
end if
end if
delay (1000)
colorback(15)
cls
setscreen ("graphics:vga")
setscreen ("nocursor")
for p:0..500
drawarc (maxx, maxy, 50+p, 50+p, 180, 270, 1)
drawarc (maxx, 0, 50+p, 50+p, 270, 180, 15)
drawarc (0, maxy, 50+p, 50+p, 270, 360, 3)
drawarc (0, 0, 50+p, 50+p, 360, 270, 2)
end for
put "Enter a letter from the alphabet"
var letter : string (1)
getch (letter)
put " "
setscreen ("nocursor")
setscreen ("noecho")
if letter = "a" then
put "A WHAT!!!"
setscreen ("echo")
setscreen ("cursor")
var tenner : string
get tenner : *
put "Don't have one of those"
elsif letter = "b" then
put "I don't like bees"
elsif letter = "c" then
put "I've never been to sea"
elsif letter = "d" then
put "What kind of a letter is d, never give that letter to me again!"
delay (2000)
cls
return
elsif letter = "e" then
put "Your wrong mortal!!"
delay (2000)
cls
return
elsif letter = "f" then
put "Don't swear at me!"
delay (2000)
cls
return
elsif letter = "g" then
put "I will not wait while you reminisce"
delay (1000)
cls
return
elsif letter = "h" then
put "Don't say the letter! It is the one letter the servants of the box"
put "cannot hear!!"
delay (2000)
cls
return
elsif letter = "i" then
put "You what!"
setscreen ("echo")
setscreen ("cursor")
var teenner : string
get teenner : *
put "Okay"
elsif letter = "j" then
put "The almighty J is my creator. As long as you never speak"
put "ill of him you shall live"
elsif letter = "k" then
put "What are you agreeing to?"
var agree : string
get agree : *
if agree = "you" then
put "Good"
elsif agree < "you" or agree > "you" then
put "How dare you agree with such a vile concept!"
delay (2000)
cls
return
end if
elsif letter = "l" then
put "Mortal!"
delay (2000)
cls
return
elsif letter = "m" then
put "Yes Marko IS a funny guy"
elsif letter = "n" then
put "Yes you are nothing compared to me"
elsif letter = "o" then
put "What?"
setscreen ("echo")
setscreen ("cursor")
var Oh : string
get Oh : *
elsif letter = "p" then
elsif letter = "p" then
put "Do not excrete in the general premises. If you must then please go"
put "across the hall first"
elsif letter = "q" then
put "Be quiet mortal!"
delay (2000)
cls
return
elsif letter = "r" then
put "I am not a pirate, I am a God!"
delay (2000)
var tru : int
loop
randint (tru, 1, 15)
colorback (tru)
cls
end loop
elsif letter = "s" then
put "BY!"
delay (2000)
cls
return
elsif letter = "t" then
put "Tell me, why did you type in 't'?"
var t : string
setscreen ("echo")
setscreen ("cursor")
get t : *
put "That's interesting"
elsif letter = "u" then
put "What about me?!"
var what : string
setscreen ("echo")
setscreen ("cursor")
get what : *
put "Go away little one"
delay (2000)
cls
return
elsif letter = "v" then
put
"That show is a little old don't you think? I definently don't watch it"
elsif letter = "w" then
put "This letter is illogical, go away"
delay (2000)
cls
return
elsif letter = "x" then
put "X does not mark the spot"
delay (1000)
cls
return
elsif letter = "y" then
put "If you want to ask a question then you should consult the box"
elsif letter = "z" then
put "I know my ABC's, but you'll never hear ME sing them"
end if
put "The Multiple Choice Program"
put " "
put " "
put "Enter a number equal to the number placed with an answer"
var a1, a2, a3, a4, a5, a6, a7, a8, a9, a0:int
put "Turing is"
put " (1) a great programming language"
put " (2) a kind of car"
put " (3) a mathemation"
put " (4) a machine"
put " (5) all of the above"
put " (6) none of the above"
loop
get a1
case a1 of
label 1: put "That is correct"
label 2: put "Wrong"
label 3: put "Turing the person is no longer alive so this answer is false"
label 4: put "wrong"
label 5: put "Non - compliant"
label 6: put "Incorrect"
label: put "Invalid answer, please re-enter"
end case
exit when a1 = 1
end loop
put " "
put " "
put "Who is Stroy"
put " (1) A magic elf infesting the Turing program"
put " (2) A menial servant of the almighty box"
put " (3) A program"
put " (4) All of the above"
put " (5) None of the above"
loop
get a2
case a2 of
label 1: put "Incomplete"
label 2: put "Incomplete"
label 3: put "Incomplete"
label 4: put "Correct, and all so very true!"
label 5: put "Very wrong"
end case
exit when a2 = 4
end loop
put " "
put " "
delay (1000)
cls
put "What do you think of Jim Diamond"
put " (1) He is very weird"
put " (2) He is extremely intelligent"
put " (3) He is obese"
put " (4) He is ugly"
put " (5) He is hot"
put " (6) He is intelligent"
put " (7) I never want to see his ugly hide again!"
loop
get a3
case a3 of
label 1: put "That is not very nice"
label 2: put "Thank you"
label 3: put "Eeww"
label 4: put "How dare you!"
label 5: put "I...I...I don't know what to say"
label 6: put "Thank you"
label 7: put "Fine then, Boo Hoo" exit
label: put "Incorrect answer, please re-enter"
end case
exit when a3 = 1 or a3 = 2 or a3 = 3 or a3 = 4 or a3 = 5 or a3 = 6
end loop
if a3 = 7 then
return
end if
put " "
put " "
put "What part does James play in 'The Truth About Cinderella'"
put " (1) The Prince"
put " (2) Man Number 1"
put " (3) The King"
put " (4) Curtain Boy"
put " (5) All of the above"
put " (6) He's not in the play"
put " (7) None of the above"
loop
get a4
case a4 of
label 1: put "No, but their related"
label 2: put "Wrong"
label 3: put "Correct! Jim is the king, Bow!"
label 4: put "No that was last year"
label 5: put "No"
label 6: put "Aaaahhhh, That's sooooo wrong"
label 7: put "Incorrect"
label: put "False answer, please reanswer"
end case
exit when a4 = 3
end loop
delay (1000)
cls
put "Who are you"
put " (1) Sabrina"
put " (2) Marko"
put " (3) Andrew"
put " (4) James"
put " (5) Devin"
put " (6) Jake"
put " (7) None of the above"
put " (8) Mr. Ielapi"
put " (9) Mike"
loop
get a5
case a5 of
label 1: put "Welcome to the wonderful world of multiple choice!"
label 2: put "Thank you for answering this question" exit
label 3: put "I'll not have you outscoring me!" exit
label 4: put "I'm so brilliant aren't I!!" exit
label 5: put "What are you doing here!!!" exit
label 6: put "Go away young one" exit
label 7: put "GET OFF MY COMPUTER!!!!" exit
label 8: put "Hello, I hope I didn't spell your name wrong" exit
label 9: put "This program is smarter than you! HA!" exit
label: put "Incorrect number please re-enter" exit
end case
end loop
put " "
put " "
put "Why are you answering these questions?"
put " (1) You don't know"
put " (2) The almighty James asked you to"
put " (3) You felt like it"
put " (4) All of the above"
put " (5) None of the above"
loop
get a6
case a6 of
label 1: put "Whatever" exit
label 2: put "He's always right" exit
label 3: put "Interesting" exit
label 4: put "That's not possible!"
label 5: put "Why then?"
var getting: string
get getting:*
for a:1..5
put "Why?"
get getting:*
if a = 5 then
put "You don't know why do you?"
end if
end for
label: put "Invalid answer, please reanswer"
end case
end loop
setscreen ("graphics:vga")
%Coin - Flip program as done by James Diamond
var heads : string := "H" %The heads side of the coin
var tails : string := "T" %The tails side of the coin
var coin : string %The side the coin landed on
var guess : string (1) %What you guess
var score : int := 0 %Your current score
var counte : int := 0 % The amount of time before the loop ends
var ran : int %The random variable that determines whether the coin landed on heads or tails
randomize
var invalid: int:=0 %This variable has no purpose
color (12)
loop
setscreen ("nocursor")
var j2 : int := maxx div 2 %A coordinate for the coin drawing
var h2 : int := 20 %A coordinate for the coin drawing
var yr, xr : int := 0 %Radius variables
var ychange, xrchange, yrchange : int := 1 %The amount the coordinates change by
drawfilloval (maxx div 2, 20, 20, 1, 0)
loop
drawfilloval (j2, 20, 20, 1, 0) %The coin that flips up and down
drawfilloval (j2, h2, 20, yr, 14)
delay (3)
drawfilloval (j2, h2, 20, yr, 0)
yr := yr + yrchange
if yr >= 20 or yr <= - 20 then
yrchange := - yrchange
end if
if h2 >= 20 and h2 <= 200 then
%y := ( (x - maxx div 2) ** 2) + 20
h2:=h2 + ychange
ychange := + ychange
end if
if h2 = 200 then
ychange := - ychange
end if
if h2 <= 200 then
j2 := j2 - xrchange
end if
if j2 = 6 then
xrchange := - xrchange
end if
exit when h2 = 20
end loop
drawfilloval (j2, 20, 20, 1, 14)
locate (3, 1)
put " "
locate (1, 1)
randint (ran, 1, 2)
setscreen ("cursor")
put "I think someone flipped a coin. Is it Heads or Tails?" ..
%Asks user for response
put " "
locate (2, 1)
getch (guess)
put " "
if guess = "h" then
guess := "H"
elsif guess = "t" then
guess := "T"
end if
if ran = 1 then
coin := heads
else
coin := tails
end if
if guess = coin then
score := score + 10
put "correct! "
elsif guess = "H" then
score := score - 10
put "Incorrect! "
elsif guess = "T" then
score := score - 10
put "Incorrect! "
else
put "Invalid answer, Please use 'H' or'T'."
invalid := invalid + 1
end if
if guess = "H" or guess = "T" or guess = "h" or guess = "t" then
counte := counte + 1
end if
locate (4, 1)
put "Your score is ", score, " "
locate (5, 1)
put "You have entered ", counte, " valid guesses"
loop
setscreen ("nocursor")
drawfilloval (j2, 20, 20, 1, 0)
j2 := j2 + 1
drawfilloval (j2, 20, 20, 1, 14)
delay (3)
exit when j2 = maxx div 2
end loop
exit when counte = 15
end loop
locate (4, 1)
put "Your score is ", score, " out of 150"
locate (6, 1)
put "You have entered ", invalid, " invalid guesses"
drawfilloval (20, 20, 20, 20, 12)
Hope you enjoy the program. Its more fun than sense so don't look on it too literally.
