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

Username:   Password: 
 RegisterRegister   
 whak-a-mole
Index -> Programming, Turing -> Turing Submissions
View previous topic Printable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic
Author Message
guttface




PostPosted: Sun Feb 29, 2004 7:18 pm   Post subject: whak-a-mole

Hey. This is my first submited code. Tell me waht you think!
code:

%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% WHAK-A-MOLE              %
% BY: MATT GUTTMAN         %
% LAST MODIFIED: FEB 17/04 %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%

setscreen ("graphics:340;360,position:300;200,nocursor,title:Whak-A-Mole")

var name : string
var sound1 : string
var molenum : int
var molenum2 : int
var difficulty : string (1)
var delay1 : int
var x : int := 60
var y : int := 60
var x1 : int := 60
var y1 : int := 60
var x2 : int := 60
var y2 : int := 60
var timeremain : int := 30
var timeposition : int := maxcol - 3
var gameover : int := 0
var countdownnum : int := 6
var btnnum : int
var btnupdn : int
var moux : int
var mouy : int
var moux1 : int
var mouy1 : int
var score : int := 0
var duration : int
var duration2 : int
var streamNumber : int
var filename : string
var hiscore : array 1 .. 10 of int
var hiscorer : array 1 .. 10 of string
var scorerank : int := 11
var scorerankword : string
var newhigh : string := ""
var count : int := 11
var endprog : string (1)
var fontId : int := Font.New ("verdana:34:bold")
var a : int := 0000
var c : int := 0000
var x4 : int := 10
var y4 : int := 210
var text : string := "Matt"
var buffer : string := ""
var x3 : array 1 .. length (text) of int
var y3 : array 1 .. length (text) of int

colourback (7)
cls

Font.Draw ("WHAK-A-MOLE", 10, 315, fontId, 2)
delay (500)
Font.Draw ("BY:", 10, 265, fontId, 3)
delay (250)
fontId := Font.New ("verdana:45:bold")

for i : 1 .. length (text)
    x3 (i) := x4 + Font.Width (buffer, fontId)
    y3 (i) := y4
    buffer += text (i)
end for

for decreasing i : length (text) .. 1
    for k : 1 .. x3 (i)
        Font.Draw (text (i), k, y3 (i), fontId, 14)
        delay (1)
        drawline (k - 1, y3 (i) - 5, k - 1, y3 (i) + 50, 7)
        Font.Draw (text (i), k - 2, y3 (i), fontId, 7)
    end for
    Font.Draw (text (i), x3 (i), y3 (i), fontId, 14)
    delay (50)
end for

a := 0000
c := 0000
x4 := 10
y4 := 160
text := "Guttman"
buffer := ""
var x5 : array 1 .. length (text) of int
var y5 : array 1 .. length (text) of int


for i : 1 .. length (text)
    x5 (i) := x4 + Font.Width (buffer, fontId)
    y5 (i) := y4
    buffer += text (i)
end for

for decreasing i : length (text) .. 1
    for k : 1 .. x5 (i)
        Font.Draw (text (i), k, y5 (i), fontId, 43)
        delay (1)
        drawline (k - 1, y5 (i) - 5, k - 1, y5 (i) + 50, 7)
        Font.Draw (text (i), k - 2, y5 (i), fontId, 7)
    end for
    Font.Draw (text (i), x5 (i), y5 (i), fontId, 43)
    delay (50)
end for

delay (100)

for count1 : 1 .. 2
    drawfilloval (75, 10, 40, 10, 7)
    drawfillbox (65, 15, 125, 55, 7)


    drawfilloval (75, 46, 40, 40, 4)
    drawfilloval (55, 66, 5, 5, 2)
    drawfilloval (95, 66, 5, 5, 2)
    drawarc (75, 26, 20, 10, 180, 0, 2)

    drawfillbox (110, 80, 150, 100, 0)
    drawfillbox (125, 30, 135, 80, 0)

    delay (500)

    drawfilloval (75, 46, 40, 40, 7)
    drawfillbox (110, 30, 150, 100, 7)

    drawfilloval (75, 10, 40, 4, 4)
    drawfilloval (55, 12, 1, 1, 2)
    drawfilloval (95, 12, 1, 1, 2)
    drawarc (75, 8, 20, 1, 180, 0, 2)

    drawfillbox (65, 15, 85, 55, 0)
    drawfillbox (85, 30, 135, 40, 0)

    delay (500)
end for

drawfilloval (75, 10, 40, 10, 7)
drawfillbox (65, 15, 125, 55, 7)


drawfilloval (75, 46, 40, 40, 4)
drawfilloval (55, 66, 5, 5, 2)
drawfilloval (95, 66, 5, 5, 2)
drawarc (75, 26, 20, 10, 180, 0, 2)

drawfillbox (110, 80, 150, 100, 0)
drawfillbox (125, 30, 135, 80, 0)

delay (500)

colourback (0)
cls
setscreen ("cursor")

loop
    cls
    put "Enter your name:   " ..
    get name : *
    exit when length (name) > 2 and length (name) < 19

    if length (name) < 3 then
        cls
        setscreen ("nocursor,noecho")
        put "THAT NAME IS TOO SHORT!"
        delay (2000)
        setscreen ("cursor,echo")
    elsif length (name) > 18 then
        cls
        setscreen ("nocursor,noecho")
        put "THAT NAME IS TOO LONG!"
        delay (2000)
        setscreen ("cursor,echo")
    end if
end loop

loop
    cls
    put "Enter difficulty 1-3:   " ..
    getch (difficulty)
    exit when difficulty = "1" or difficulty = "2" or difficulty = "3"
end loop

loop
    cls
    put "Sound on or off?   " ..
    get sound1
    exit when sound1 = "on" or sound1 = "off"
end loop

cls

setscreen ("nocursor,noecho")

if difficulty = "1" then
    delay1 := 250
    duration := 120
    duration2 := 60
    filename := Dir.Current + "\\highscore1"
elsif difficulty = "2" then
    delay1 := 125
    duration := 237
    duration2 := 118
    filename := Dir.Current + "\\highscore2"
elsif difficulty = "3" then
    delay1 := 63
    duration := 470
    duration2 := 234
    filename := Dir.Current + "\\highscore3"
end if

if sound1 = "on" then
    sound1 := "<<1c"
else
    sound1 := ""
end if

drawbox (0, 0, 340, 340, 17)
drawbox (10, 10, 330, 330, 17)
drawfill (5, 5, 17, 17)
drawfillbox (110, 0, 120, 340, 17)
drawfillbox (220, 0, 230, 340, 17)
drawfillbox (0, 110, 340, 120, 17)
drawfillbox (0, 220, 340, 230, 17)

procedure countdown
    loop
        countdownnum := countdownnum - 1
        locate ( (maxrow div 2) + 1, maxcol div 2)
        put countdownnum
        delay (1000)
        exit when countdownnum = 0
    end loop
    locate ( (maxrow div 2) + 1, maxcol div 2)
    put " "
end countdown

process timer
    loop
        timeremain := timeremain - 1
        if timeremain < 10 then
            locate (1, maxcol - 3)
            put "0"
            timeposition := maxcol - 2
        end if
        locate (1, timeposition)
        put timeremain
        delay (1000)
        exit when timeremain = 0
    end loop
    gameover := 1
end timer

process drawmole
    for count : 1 .. duration
        randint (molenum, 1, 9)
        if molenum = 1 then
            x := 60
            y := 60
        elsif molenum = 2 then
            x := 170
            y := 60
        elsif molenum = 3 then
            x := 280
            y := 60
        elsif molenum = 4 then
            x := 60
            y := 170
        elsif molenum = 5 then
            x := 170
            y := 170
        elsif molenum = 6 then
            x := 280
            y := 170
        elsif molenum = 7 then
            x := 60
            y := 280
        elsif molenum = 8 then
            x := 170
            y := 280
        elsif molenum = 9 then
            x := 280
            y := 280
        end if
        drawfilloval (x, y, 40, 40, 4)
        drawfilloval (x - 20, y + 20, 5, 5, 2)
        drawfilloval (x + 20, y + 20, 5, 5, 2)
        drawarc (x, y - 20, 20, 10, 180, 0, 2)
        delay (delay1)
    end for
end drawmole

process manerasemole (moux1 : int, mouy1 : int)
    if moux1 > 18 and moux1 < 102 and mouy1 > 18 and mouy1 < 102 then
        x1 := 60
        y1 := 60
    elsif moux1 > 128 and moux1 < 212 and mouy1 > 18 and mouy1 < 102 then
        x1 := 170
        y1 := 60
    elsif moux1 > 238 and moux1 < 322 and mouy1 > 18 and mouy1 < 102 then
        x1 := 280
        y1 := 60
    elsif moux1 > 18 and moux1 < 102 and mouy1 > 128 and mouy1 < 212 then
        x1 := 60
        y1 := 170
    elsif moux1 > 128 and moux1 < 212 and mouy1 > 128 and mouy1 < 212 then
        x1 := 170
        y1 := 170
    elsif moux1 > 238 and moux1 < 322 and mouy1 > 128 and mouy1 < 212 then
        x1 := 280
        y1 := 170
    elsif moux1 > 18 and moux1 < 102 and mouy1 > 238 and mouy1 < 322 then
        x1 := 60
        y1 := 280
    elsif moux1 > 128 and moux1 < 212 and mouy1 > 238 and mouy1 < 322 then
        x1 := 170
        y1 := 280
    elsif moux1 > 238 and moux1 < 322 and mouy1 > 238 and mouy1 < 322 then
        x1 := 280
        y1 := 280
    end if
    drawfilloval (x1, y1, 40, 40, 0)
    play (sound1)
    score := score + 100
    locate (1, (maxcol div 2) - 1)
    put score
end manerasemole

process autoerasemole
    delay (500)
    for count : 1 .. duration2
        randint (molenum2, 1, 9)
        if molenum2 = 1 then
            x2 := 60
            y2 := 60
        elsif molenum2 = 2 then
            x2 := 170
            y2 := 60
        elsif molenum2 = 3 then
            x2 := 280
            y2 := 60
        elsif molenum2 = 4 then
            x2 := 60
            y2 := 170
        elsif molenum2 = 5 then
            x2 := 170
            y2 := 170
        elsif molenum2 = 6 then
            x2 := 280
            y2 := 170
        elsif molenum = 7 then
            x2 := 60
            y2 := 280
        elsif molenum2 = 8 then
            x2 := 170
            y2 := 280
        elsif molenum2 = 9 then
            x2 := 280
            y2 := 280
        end if
        drawfilloval (x2, y2, 40, 40, 0)
        delay (delay1 * 2)
    end for
end autoerasemole

procedure checkhighscore
    for decreasing i : 10 .. 1
        if score > hiscore (i) then
            scorerank := i
        end if
    end for
end checkhighscore

procedure changescorelist
    loop
        count := count - 1
        exit when scorerank = count
        hiscore (count) := hiscore (count - 1)
    end loop
    hiscore (count) := score
    count := 11
    loop
        count := count - 1
        exit when scorerank = count
        hiscorer (count) := hiscorer (count - 1)
    end loop
    hiscorer (count) := name
end changescorelist

locate (1, 1)
put "                                       "
locate (1, 1)
put name
locate (1, maxcol div 2)
put "0"
locate (1, timeposition)
put "30"

countdown
fork timer
fork drawmole
fork autoerasemole

loop
    if buttonmoved ("down") then
        buttonwait ("down", moux, mouy, btnnum, btnupdn)
        if whatdotcolour (moux, mouy) = 4 or whatdotcolour (moux, mouy) = 2
            then
            fork manerasemole (moux, mouy)
        end if
    end if
    exit when gameover = 1
end loop

delay (500)

open : streamNumber, filename, get
if streamNumber > 0 then
    for i1 : 1 .. 10
        get : streamNumber, hiscore (i1)
    end for
    for i2 : 1 .. 10
        get : streamNumber, hiscorer (i2) : *
    end for
    close : streamNumber
else
    for i3 : 1 .. 10
        hiscore (1) := 10000
        hiscore (2) := 9000
        hiscore (3) := 8000
        hiscore (4) := 7000
        hiscore (5) := 6000
        hiscore (6) := 5000
        hiscore (7) := 4000
        hiscore (8) := 3000
        hiscore (9) := 2000
        hiscore (10) := 1000
    end for
    for i4 : 1 .. 10
        hiscorer (i4) := "Matt Guttman"
    end for
end if

checkhighscore

if scorerank < 11 then
    scorerankword := intstr (scorerank)
    newhigh := "NEW HIGH SCORE #" + scorerankword + "!"
    changescorelist
end if

cls
locate (1, (maxcol div 2) - 4)
put "GAME OVER"
put skip
put "Your score: ", score, "   ", newhigh
locate (6, (maxcol div 2) - 5)
put "HIGH SCORES"
put skip

for i5 : 1 .. 10
    put hiscorer (i5) : 20, hiscore (i5)
end for

open : streamNumber, filename, put
assert streamNumber > 0
for i6 : 1 .. 10
    put : streamNumber, hiscore (i6)
end for
for i7 : 1 .. 10
    put : streamNumber, hiscorer (i7)
end for
close : streamNumber

put skip
put "Press any key to exit"
getch (endprog)
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: