Programming C, C++, Java, PHP, Ruby, Turing, VB
Computer Science Canada 
Programming C, C++, Java, PHP, Ruby, Turing, VB  

Username:   Password: 
 RegisterRegister   
 Christmas Tree Program
Index -> Programming, Turing -> Turing Submissions
View previous topic Printable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic
Author Message
chrispminis




PostPosted: Sat Dec 24, 2005 11:39 am   Post subject: Christmas Tree Program

This was something I did for a before Christmas Holiday's assignment. It's basically a tree, just all visual effects but yeah.. sorta fun? Just a last question. Whats the diff between Turing Source Code and Turing Applications?

There are some useful stuff in the coding. Such as some Christmas music if anyone wanted any lol.

Had trouble uploading so... here's the source.

code:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                                    Christmas Tree!                                %
%                                     By:Chris Pan                                  %
%          Designed to draw a Christmas Tree based on height, input by user.        %
%                       Many concepts learned at www.compsci.ca                     %
%              TextDelay feature taken from Ted Livingston's Last Hope RPG          %
%      and Menu loosely based around George Fehr's Mini Golf menu, mostly concept.  %
%                   Music template taken from bored_hacker's Mario Song.            %
%              TextDelay, menu, and/or music will be removed upon request.          %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%Variables

%tree
var height : int
var treeheight, treewidth, treestart : int
%colours
var colTitle : int := 12
var colPlay : int := 2
var colHelp : int := 113
var colQuit : int := 2
var colBack : int := 113
var colBallProb, colBall1, colBall2 : int
%star
var starsize : int
%fonts
var fontTitle, fontSubtitle, fontCredits : int
%mouse
var mx, my, mb : int
fontTitle := Font.New ("Arial:48")
fontSubtitle := Font.New ("Arial:30")
fontCredits := Font.New ("Arial:18")
%text delay
var text : string
var y1 : int
%music
const tempo := 240
%Note-Duration (or rests)
%Normal-Notes
const w := round (2000 * (120 / tempo)) %Whole notes
const h := round (1000 * (120 / tempo)) %Half Notes
const q := round (500 * (120 / tempo))  %Quarter Notes
const e := round (250 * (120 / tempo))  %Eighth Notes
const s := round (125 * (120 / tempo))  %Sixteenth Notes
%Dotted-Notes
const w_dot := round (w * 1.5)
const h_dot := round (h * 1.5)
const q_dot := round (q * 1.5)
const e_dot := round (e * 1.5)
const s_dot := round (s * 1.5)
%Triplet-Notes
const w3 := round (w * 2 / 3)
const h3 := round (h * 2 / 3)
const q3 := round (q * 2 / 3)
const e3 := round (e * 2 / 3)
const s3 := round (s * 2 / 3)
%Notes
const G := 392
const Gs := 415
const Ab := 415
const A := 440
const As := 466
const Bb := 466
const B := 494
const C := 523
const Cs := 554
const Db := 554
const D := 587
const Ds := 622
const Eb := 622
const E := 659
const F := 698
const Fs := 740
const Gb := 740

%misc
var spotx : int
var spoty : int

%Procedures


%Text
procedure TextDelay (y1 : int, text : string)
    for i : 1 .. length (text) %sets for loop's length to texts amount of characters.
        color (10) %green
        locate (y1, maxcol div 2 - length (text) div 2 - 1 + i)
        put text (i) %types one character
        delay (30)
        color (2) %faded green
        locate (y1, maxcol div 2 - length (text) div 2 - 1 + i) %retypes character in diff colour
        put text (i)
    end for
end TextDelay

%Moon Secret
procedure moonsecret
    View.Set ("graphics:639;399") %Set screen to 639 by 399 pixels (default)
    cls
    colourback (black) %sets background to black
    cls
    Font.Draw ("Moon Secret", 200, 350, fontSubtitle, colTitle) %draws title text
    text := "Welcome to the Moon Secret"
    y1 := 5
    TextDelay (y1, text)
    text := "This is basically a list of all the secrets in the program."
    y1 := 7
    TextDelay (y1, text)
    text := " 1. Clicking the top bauble will randomly change the colour of the baubles."
    y1 := 9
    TextDelay (y1, text)
    text := "2. Clicking on the leftmost star will cause it to expand. :)"
    y1 := 11
    TextDelay (y1, text)
    text := "3. Look at the snow on the ground, one dots should be larger and red."
    y1 := 13
    TextDelay (y1, text)
    text := "Click it and a black hole appears. Click again to stop it."
    y1 := 14
    TextDelay (y1, text)
    loop
        Mouse.Where (mx, my, mb)
        colBack := 113 %sets back button colour to faded red
        if mx > 9 and mx < 119 then
            if my > 9 and my < 59 then
                colBack := 12 %when mouse moves over button, button changes colour to bright red.
            end if
        end if
        if mx > 9 and mx < 119 then
            if my > 9 and my < 59 then
                if mb = 1 then
                    exit %when button is clicked exit procedure loop
                end if
            end if
        end if
        Draw.Box (10, 10, 118, 58, black) %draws the back button
        Font.Draw ("Back", 20, 20, fontSubtitle, colBack) %draws the back text
        View.Update %updates the screen
    end loop
end moonsecret

%Spot Black Hole
procedure blackhole
    var colBlackDecide : int
    var colBlack : int
    var BlackPosX, BlackPosY : int

    loop
        Mouse.Where (mx, my, mb)
        randint (colBlackDecide, 1, 3) %choose colour of line
        randint (BlackPosX, mx - 100, mx + 100) %choose x position for line
        randint (BlackPosY, my - 100, my + 100) %choose y position for line

        if colBlackDecide > 1 then
            colBlack := black % 2 in 3 chance for black line
        elsif colBlackDecide = 1 then
            colBlack := white %1 in 3 chance for white line
        end if

        if mb = 1 then
            exit %when user clicks, end blackhole
        end if

        Draw.Line (BlackPosX, BlackPosY, mx, my, colBlack) %draws lines towards cursor, creating blackhole effect
    end loop
end blackhole


%Tree
procedure drawtree
    cls
    colorback (white) %sets background to white
    cls
    loop
        color (black) %sets text colour to white
        locate (5, 20) %locates text
        put "Choose height of tree between 11 and 20"
        locate (6, 39)
        get height %get user input
        if height > 20 then %error if input exceeds 20
            locate (8, 13)
            put "Thats higher than 20, choose a number between 11 and 20"
            locate (9, 22)
            put "Hit any key to enter in a new height"
            Input.Flush
            Input.Pause
            cls
        elsif height < 11 then %error if input is under 11
            locate (8, 13)
            put "Thats higher than 20, choose a number between 11 and 20"
            locate (9, 22)
            put "Hit any key to enter in a new height"
            Input.Flush
            Input.Pause
            cls
        else
            exit %otherwise move on to tree
        end if
    end loop
    cls
    View.Set ("graphics: 650; 600") %set screen to 650 by 600 pixels
    treestart := height * 22 %sets top point of tree
    treeheight := height * 16 %sets height of tree, by characters (characters are 16 pixels high)
    treewidth := height * 8 %sets width of widest part of tree.
    cls
    colourback (1) %sets the background colour to dark blue
    cls
    Draw.FillBox (1, treestart - treeheight - treeheight div 10, maxx, 1, white) %draws the snow on the ground
    for groundtexture : 1 .. 100 %draws random black dots for "texture"
        randint (spotx, 1, maxx)
        randint (spoty, 1, treestart - treeheight - treeheight div 10)
        Draw.FillOval (spotx, spoty, 1, 1, black)
        if groundtexture = 100 then
            Draw.FillOval (spotx, spoty, 2, 2, red) %last spot is secret
        end if
        Draw.FillBox (10, 10, 118, 58, black)
    end for

    %tree    draws tree with a green triangle
    drawline (325, treestart, 325 + treewidth, treestart - treeheight, black) %draws line from top point to bottom right point
    drawline (325, treestart, 325 - treewidth, treestart - treeheight, black) %draws line from top point to bottom left point
    drawline (325 + treewidth, treestart - treeheight, 325 - treewidth, treestart - treeheight, black) %draws bottom to bottom line
    drawfill (325, treestart - 10, green, black) %fills the tree triangle with green bordering it with black
    %trunk draws trunk so its a quarter of trees height and a third of tree width
    Draw.FillBox (325 - treewidth div 3, treestart - treeheight, 325 + treewidth div 3, treestart - treeheight - treeheight div 4, 4)
    %star %draws a star on top of the tree with a proportionate height
    starsize := height * 7 div 5
    Draw.FillStar (325 - starsize, treestart - starsize, 325 + starsize, treestart + starsize, 14)
    %moon
    Draw.FillOval (550, 550, 30, 30, 14) %draws the first yellow circle
    Draw.FillOval (530, 550, 22, 22, 1) %draws a second smaller blue circle to create a moon
    %stars
    Draw.FillStar (480, 540, 500, 560, 14) %draws 3 stars
    Draw.FillStar (200, 500, 220, 520, 14)
    Draw.FillStar (540, 350, 560, 370, 14)

    %baubles
    var baubledis : int := height * 4 %sets proportionate bauble distance
    var baublesize : int := height * 2 div 3 %sets proportionate bauble size
    var baublecol : int := 12
    var baubleset : int
    randint (baubleset, 101, 103) %sets initial colour

    %starenlarge
    var starenlargex1, starenlargey1, starenlargex2, starenlargey2 : int
    starenlargex1 := 100
    starenlargey1 := 320 %sets initial star size
    starenlargex2 := 120
    starenlargey2 := 340


    loop
        Mouse.Where (mx, my, mb)
        colBack := 113
        %back button
        if mx > 9 and mx < 119 then
            if my > 9 and my < 59 then
                colBack := 12
            end if
        end if
        if mx > 9 and mx < 119 then
            if my > 9 and my < 59 then
                if mb = 1 then
                    exit
                end if
            end if
        end if

        %baubles
        baublecol := baubleset
        if baubleset = 101 then
            baubleset := 12
        elsif baubleset = 102 then %sets initial bauble colour
            baubleset := 14
        elsif baubleset = 103 then
            baubleset := 1
        end if

        if mx > 325 - baublesize and mx < 325 + baublesize then
            if my > treestart - baubledis - baublesize and my < treestart - baubledis + baublesize then
                if mb = 1 then
                    randint (baubleset, 1, 50) %if top bauble is clicked, then randomlu
                end if
            end if
        end if


        %draws 5 baubles
        Draw.FillOval (325, treestart - baubledis, baublesize, baublesize, baublecol)
        Draw.FillOval (325 - baubledis div 2, treestart - baubledis * 2, baublesize, baublesize, baublecol)
        Draw.FillOval (325 + baubledis div 2, treestart - baubledis * 8 div 3, baublesize, baublesize, baublecol)
        Draw.FillOval (325 - baubledis, treestart - baubledis * 10 div 3, baublesize, baublesize, baublecol)
        Draw.FillOval (325 + baubledis, treestart - baubledis * 11 div 3, baublesize, baublesize, baublecol)

        %moon secret
        if mx > 520 and mx < 580 then
            if my > 520 and my < 580 then
                if mb = 1 then
                    moonsecret %if user clicks on the moon then execute moonsecret proc
                end if
            end if
        end if

        %star enlarge. thxto gandalf for help debugging this.
        if mx > starenlargex1 and mx < starenlargex2 and my > starenlargey1 and my < starenlargey2 and mb = 1 then
            starenlargex1 -= 5
            starenlargex2 += 5
            starenlargey1 -= 5
            starenlargey2 += 5
        end if
        Draw.FillStar (starenlargex1, starenlargey1, starenlargex2, starenlargey2, 14)
        delay (40)

        %spot blackhole
        if mx > spotx - 5 and mx < spotx + 5 then
            if my > spoty - 5 and my < spoty + 5 then
                if mb = 1 then
                    blackhole %if user clicks on random red point then execute black hole
                end if
            end if
        end if

        Font.Draw ("Back", 20, 20, fontSubtitle, colBack)
        View.Update
        delay (5)
    end loop
end drawtree

%Help
procedure help
    cls
    Font.Draw ("Help", 270, 350, fontSubtitle, colTitle)
    text := "Welcome, this program is designed to generate a Christmas Tree."
    y1 := 6
    TextDelay (y1, text)
    text := "First choose new tree in the main menu, when a new window opens."
    y1 := 8
    TextDelay (y1, text)
    text := "Then input the height of the tree, from between 11 and 20, Yay!!"
    y1 := 10
    TextDelay (y1, text)
    text := "Now that the tree has been drawn, try clicking something."
    y1 := 12
    TextDelay (y1, text)
    text := "There are many secrets in this program."
    y1 := 14
    TextDelay (y1, text)
    text := "See how many you can find."
    y1 := 16
    TextDelay (y1, text)
    text := "Oh, and turn up the volume. There is music. :)"
    y1 := 18
    TextDelay (y1, text)

    loop
        Mouse.Where (mx, my, mb)
        colBack := 113
        if mx > 9 and mx < 119 then
            if my > 9 and my < 59 then
                colBack := 12
            end if
        end if
        if mx > 9 and mx < 119 then
            if my > 9 and my < 59 then
                if mb = 1 then
                    exit
                end if
            end if
        end if
        Draw.Box (10, 10, 118, 58, black)
        Font.Draw ("Back", 20, 20, fontSubtitle, colBack)
        View.Update
    end loop
end help

%Music
process music %contains jingle bells and deck the halls
    loop

        %Jingle Bells
        %intro
        Music.Sound (C, q) %output sound based on frequency (pitch, length)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, q)
        Music.Sound (C, h_dot)
        Music.Sound (C, e)
        Music.Sound (C, e)
        Music.Sound (C, q)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, q)
        Music.Sound (D, w)
        Music.Sound (D, q)
        Music.Sound (Bb * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (E, w)
        Music.Sound (C * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (Bb * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (A * 2, w)
        Music.Sound (C, q)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, q)
        Music.Sound (C, w)
        Music.Sound (C, q)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, q)
        Music.Sound (D, h_dot)
        Music.Sound (D, q)
        Music.Sound (D, q)
        Music.Sound (Bb * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (D * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (Bb * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, h)
        Music.Sound (C * 2, h)
        %Start Chorus
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, h)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, h)
        Music.Sound (A * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (F, q_dot)
        Music.Sound (G * 2, e)
        Music.Sound (A * 2, w)
        Music.Sound (Bb * 2, q)
        Music.Sound (Bb * 2, q)
        Music.Sound (Bb * 2, q_dot)
        Music.Sound (Bb * 2, e)
        Music.Sound (Bb * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, e)
        Music.Sound (A * 2, e)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, h)
        Music.Sound (C * 2, h)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, h)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, h)
        Music.Sound (A * 2, q)
        Music.Sound (C * 2, q)
        Music.Sound (F, q_dot)
        Music.Sound (G * 2, e)
        Music.Sound (A * 2, w)
        Music.Sound (Bb * 2, q)
        Music.Sound (Bb * 2, q)
        Music.Sound (Bb * 2, q_dot)
        Music.Sound (Bb * 2, e)
        Music.Sound (Bb * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (A * 2, e)
        Music.Sound (A * 2, e)
        Music.Sound (C * 2, h)
        Music.Sound (C * 2, h)
        Music.Sound (Bb * 2, h)
        Music.Sound (G * 2, h)
        Music.Sound (F, w_dot)
        delay (w_dot) %rest

        %Deck the halls
        Music.Sound (C * 2, q_dot)
        Music.Sound (Bb * 2, e)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, q)
        Music.Sound (G * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (F, q)
        Music.Sound (G * 2, e)
        Music.Sound (A * 2, e)
        Music.Sound (Bb * 2, e)
        Music.Sound (G * 2, e)
        Music.Sound (A * 2, q_dot)
        Music.Sound (G * 2, e)
        Music.Sound (F, q)
        Music.Sound (E, q)
        Music.Sound (F, h)
        Music.Sound (C * 2, q_dot)
        Music.Sound (Bb * 2, e)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, q)
        Music.Sound (G * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (F, q)
        Music.Sound (G * 2, e)
        Music.Sound (A * 2, e)
        Music.Sound (Bb * 2, e)
        Music.Sound (G * 2, e)
        Music.Sound (A * 2, q_dot)
        Music.Sound (G * 2, e)
        Music.Sound (F, q)
        Music.Sound (E, q)
        Music.Sound (F, h)
        Music.Sound (G * 2, q_dot)
        Music.Sound (A * 2, e)
        Music.Sound (Bb * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (A * 2, q_dot)
        Music.Sound (Bb * 2, e)
        Music.Sound (C * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (A * 2, e)
        Music.Sound (Bb * 2, e)
        Music.Sound (C * 2, q)
        Music.Sound (D * 2, e)
        Music.Sound (E * 2, e)
        Music.Sound (F * 2, q)
        Music.Sound (E * 2, q)
        Music.Sound (D * 2, q)
        Music.Sound (C * 2, h)
        Music.Sound (C * 2, q_dot)
        Music.Sound (Bb * 2, e)
        Music.Sound (A * 2, q)
        Music.Sound (G * 2, q)
        Music.Sound (F, q)
        Music.Sound (G * 2, q)
        Music.Sound (A * 2, q)
        Music.Sound (F, q)
        Music.Sound (D*2, e)
        Music.Sound (D*2, e)
        Music.Sound (D*2, e)
        Music.Sound (D*2, e)
        Music.Sound (C*2, q_dot)
        Music.Sound (Bb*2, e)
        Music.Sound (A*2, q)
        Music.Sound (G*2, q)
        Music.Sound (F, w_dot)
        delay (w_dot) %rest
    end loop
end music

%Title Screen
View.Set ("graphics:639;399") %set screen to default size, 639 by 399 pixels
colourback (black) %set background colour to black
cls
fork music %fork the jinglebells music
loop
    colourback (black)
    colTitle := 12
    colPlay := 2 %sets menu option original colours, faded.
    colHelp := 113
    colQuit := 2

    Mouse.Where (mx, my, mb)

    if mx > 245 and mx < 420 then
        if my > 210 and my < 245 then
            colPlay := 10 %when user moves mouse over play button, play button brightens
        end if
    end if
    if mx > 285 and mx < 375 then
        if my > 140 and my < 175 then
            colHelp := 12 %when user moves mouse over help button, help button brightens
        end if
    end if
    if mx > 288 and mx < 378 then
        if my > 70 and my < 105 then
            colQuit := 10 %when user moves mouse over quit button, quit button brightens
        end if
    end if

    if mx > 245 and mx < 420 then
        if my > 210 and my < 245 then
            if mb = 1 then
                drawtree %when user clicks play execute drawtree proc
                View.Set ("graphics:639;399") %set screen to default size when proc ends
                colourback (black) %reset background to black when proc ends
                cls
            end if
        end if
    end if
    if mx > 285 and mx < 375 then
        if my > 140 and my < 175 then
            if mb = 1 then
                help %when user clicks help execute help proc
                colourback (black) %reset background to black when proc ends
                cls
            end if
        end if
    end if
    if mx > 288 and mx < 378 then
        if my > 70 and my < 105 then
            if mb = 1 then
                cls
                Font.Draw ("Thank you for trying Chris's Christmas Tree", 90, 225, fontCredits, colTitle)
                Draw.ThickLine (85, 215, 560, 215, 2, 10)
                delay (1000)
                exit
            end if
        end if
    end if
    Font.Draw ("Christmas Tree", 105, 325, fontTitle, colTitle) %draw the buttons
    Font.Draw ("New Tree", 245, 210, fontSubtitle, colPlay)
    Font.Draw ("Help", 285, 140, fontSubtitle, colHelp)
    Font.Draw ("Quit", 288, 70, fontSubtitle, colQuit)
    Font.Draw ("By: Chris Pan", 255, 290, fontCredits, colTitle)
    %Glitter Effect
    randint (colBallProb, 1, 2) %chooses colour of title balls
    if colBallProb = 1 then
        colBall1 := 10
        colBall2 := 12
    else
        colBall1 := 12
        colBall2 := 10
    end if
    Draw.FillOval (140, 50, 10, 10, colBall1) %draw title balls
    Draw.FillOval (50, 160, 10, 10, colBall2)
    Draw.FillOval (140, 270, 10, 10, colBall1)
    Draw.FillOval (50, 360, 10, 10, colBall2)
    Draw.FillOval (500, 50, 10, 10, colBall2)
    Draw.FillOval (590, 160, 10, 10, colBall1)
    Draw.FillOval (500, 270, 10, 10, colBall2)
    Draw.FillOval (590, 360, 10, 10, colBall2)
    View.Update
    delay (5)
end loop





Sponsor
Sponsor
Sponsor
sponsor
Display posts from previous:   
   Index -> Programming, Turing -> Turing Submissions
View previous topic Tell A FriendPrintable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic

Page 1 of 1  [ 1 Posts ]
Jump to:   


Style:  
Search: