Board Logo
« Text - Based Challenge »

Welcome Guest. Please Login or Register.
Feb 25th, 2018, 7:57pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1 2 3 4  5 Notify Send Topic Print
 veryhotthread  Author  Topic: Text - Based Challenge  (Read 3173 times)
Joseph E.
Full Member
ImageImageImageImage


member is offline

Avatar

Hello.


PM

Gender: Male
Posts: 266
xx Re: Text - Based Challenge
« Reply #15 on: Jul 20th, 2008, 3:58pm »

on Jul 20th, 2008, 3:11pm, mylifedrive wrote:
I've got a question- when should we post or program? I finished mine- grin but I'm a bit hesitsnt to post it until the challenge is over... undecided


You can post your program any time before the deadline. You are welcome to update your program as much as you like before the challenge is over.

Sometimes, though, people will look at the challenge entries that have already been posted, and try to make their own entry better. On the other hand, the advantage of posting your program soon is that people will point out any bugs they come across, allowing you to fix them before the deadline, creating a more stable program.

Of course, you don't have to be that competitive, since we're all in this for fun. Their aren't any prizes, since this is just a "challenge."

I look forward to seeing your program.

- Joseph
User IP Logged

Want to know more? I have a list of pretty much everything I've ever done. Joseph's Personal LB Page
can4tek
Full Member
ImageImageImageImage


member is offline

Avatar

The Angel of Software

YIM YIM
Homepage PM

Gender: Male
Posts: 185
xx Re: Text - Based Challenge
« Reply #16 on: Jul 20th, 2008, 5:02pm »

Also if no one posted before the deadline... no one would know what they are up against cheesy
« Last Edit: Jul 20th, 2008, 5:02pm by can4tek » User IP Logged

Can4tek.co.uk | Creator Of Crystal & SpeedKit

3.33Ghz I3 560 Overclocked, 4GB Corsair Vengeance Ram, HD 5850 HIS Icooler 1GB GDDR5, Win7 Ultimate, 60GB Solid State + 2x500GB HDD's, Fatility Champion Sound Card.

Liberty Basic v4.04 & Justbasic v1.01
JohnDavidson
Administrator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM


Posts: 4142
xx Re: Text - Based Challenge
« Reply #17 on: Jul 20th, 2008, 11:01pm »

You could post after the deadline, if you like, but your entry will be disqualified!

John
User IP Logged

John Davidson
e-me: johnshomeport@yahoo.com
My JB Page: http://john.jbusers.com/
Did ya Libby yet? http://lblibby.com/
maddevon2222
Junior Member
ImageImageImage


member is offline

Avatar

Gunblade Master


PM

Gender: Male
Posts: 91
xx Re: Text - Based Challenge
« Reply #18 on: Jul 21st, 2008, 2:49pm »

on Jul 18th, 2008, 12:34pm, Crusader wrote:
anyone remember the game STALKER that someone made her a while ago? that was a really fun text RPG...

there are lots of text rpg's actually so i think I'll start working on mine... just need a good story!

Thanks Joseph for posting this challenging challenge!


That game is what inspired me to make my own text based RPG. I've always wanted to make a game of some sort for the computer and now I finally can. But I wont be adding mine to the competitin because it's nowhere near finished yet.
User IP Logged

"For God so loved the world that He gave His only begotten Son, that whoever believes in Him should not perish but have everlasting life." "For God did not send His Son into the world to condemn the world, but that the world through Him might be saved." John 3:16 and John 3:17
jeremyhowell
Senior Member
ImageImageImageImageImage


member is offline

Avatar

A Life? Cool! Where can I download one of those from?


Homepage PM

Gender: Male
Posts: 874
xx Re: Text - Based Challenge
« Reply #19 on: Jul 22nd, 2008, 12:50pm »

I'm working on mine now, but I may not get it finished before the deadline, so I'll probably post it in the JB Programs Shared section.
User IP Logged

The mods and admins are not paid to help you and run this forum, so give them the respect they deserve. wink

Free Games

AMD Athlon XP 2200+ 1.81Ghz, 512mb RAM, GeForce 7600 GS, Windows XP Home Edition SP3, Just BASIC 1.01
Joseph E.
Full Member
ImageImageImageImage


member is offline

Avatar

Hello.


PM

Gender: Male
Posts: 266
xx Re: Text - Based Challenge
« Reply #20 on: Jul 22nd, 2008, 9:20pm »

on Jul 18th, 2008, 6:26pm, SirDavid wrote:
I'll at least try to make something, but if I experience too many false starts before the deadline (I'm trying something pretty complex, a chatbot that understands simple sentences and questions) I will have no time to make a good entry. I know my idea is very ambitious and optomistic, but I may as well see what I can manage


on Jul 21st, 2008, 2:49pm, maddevon2222 wrote:
But I wont be adding mine to the competitin because it's nowhere near finished yet.


on Jul 22nd, 2008, 12:50pm, jeremyhowell wrote:
I'm working on mine now, but I may not get it finished before the deadline, so I'll probably post it in the JB Programs Shared section.


I bring good news! The challenge has been extended by one week. This gives you until 11:00 P.M. (your time zone) on Friday, August 1st to submit an entry!

I want all of you to be able to participate in this challenge, if it is within my means to do so.

Also, you can always add to your program after the challenge if you aren't able to get it fully complete.

It seems a lot of games are in development, so it would be perfectly fine if you entered something more or less like a smaller version of what your intended game would have been like, if you aren't able to fully complete it.

Thanks,

- Joseph
User IP Logged

Want to know more? I have a list of pretty much everything I've ever done. Joseph's Personal LB Page
jeremyhowell
Senior Member
ImageImageImageImageImage


member is offline

Avatar

A Life? Cool! Where can I download one of those from?


Homepage PM

Gender: Male
Posts: 874
xx Re: Text - Based Challenge
« Reply #21 on: Jul 22nd, 2008, 9:23pm »

Thats great!

I am having some bugs on mine, so I will try to fix them AND the computer pretty much crashed on me.
« Last Edit: Jul 23rd, 2008, 1:50pm by jeremyhowell » User IP Logged

The mods and admins are not paid to help you and run this forum, so give them the respect they deserve. wink

Free Games

AMD Athlon XP 2200+ 1.81Ghz, 512mb RAM, GeForce 7600 GS, Windows XP Home Edition SP3, Just BASIC 1.01
SirDavid
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 216
xx Re: Text - Based Challenge
« Reply #22 on: Jul 24th, 2008, 11:08am »

Here! I must double post.
Code:
    dim pieces$(7)
    dim letterTemplates$(10)
    dim gridTemplate$(50, 5)
    for x=1 to 5
        for i=1 to 50
            gridTemplate$(i, x)=mid$("TEXTRIS", q mod 7+1, 1)
            q=q+1
        next
    next
    dim grid(10, 21)
    for x=1 to 10
        grid(x, 21)=1
    next
    global readyDrop, score, list$
    letterTemplates$(1)="112131415132333435"
    letterTemplates$(2)="11213141121323331415253545"
    letterTemplates$(3)="115122423324441555"
    letterTemplates$(4)="11213112411323331444154542"
    letterTemplates$(5)="11213141513233341525354555"
    letterTemplates$(6)="2131411223334354253545"
    letterTemplates$(7)="11512242333435"
    letterTemplates$(8)="213141125213531454253545"
    letterTemplates$(9)="1151125213531454253545"
    letterTemplates$(10)="1112131415253545"
    pieces$(1)="11213141"
    pieces$(2)="11122232"
    pieces$(3)="12223132"
    pieces$(4)="11122122"
    pieces$(5)="12212231"
    pieces$(6)="12212232"
    pieces$(7)="11212232"
    for i=1 to 6
        list$=list$+str$(int(rnd(1)*7)+1)
    next
    for i=1 to 7
        text$=space$(7-i)+left$("TEXTRIS", i)
        call textrisText text$
        timer 500, [loopAround]
        wait

[loopAround]
        timer 0
        cls
    next
    for i=1 to 3
        call textrisText "       "
        timer 300, [next]
        wait

[next]
        timer 0
        cls
        call textrisText "TEXTRIS"
        timer 300, [next2]
        wait

[next2]
        cls
        timer 0
    next
    inputMode=1

[mainMenu]
    cls
    print "Hello, welcome to Textris! This game is a clone of Tetris. The"
    print "game gives you shapes, which you manipulate in an attempt"
    print "to create horizontal lines. But don't let them stack up to the"
    print "top, or it's game over! Enter h for more instructions, enter o"
    print "for options, enter anything else for new game. Note that this"
    print "version does not allow the shapes to drop of their own"
    print "accord, giving you more time to plan out your ideas."
    input "";todo$
    if lower$(mid$(todo$, 1, 1))="h" then
        cls
        print "The shapes begin at the top. You may press s to move the"
        print "shapes down, w to rotate them, a to move them left, and d to"
        print "move them right. Once you press down and it cannot go down"
        print "any further, it stops and becomes part of the terrain. If an"
        print "entire row is filled, the row is cleared and the rows above"
        print "it drop. You also score 1 point if you eliminated 1 row, 3"
        print "for 2 rows, 6 for 3 rows, and 10 for 4 rows. At the"
        print "right, you can see which pieces are coming up next. If the"
        print "shapes stack up to the top, you lose! Good luck!"
        print "Press enter to go back to the main menu."
        input "";dummy
        goto[mainMenu]
    end if
    if lower$(mid$(todo$, 1, 1))="o" then
        print "There are two forms of entering the controls. With option"
        print "one, you enter your selection and press enter. Option two"
        print "does not require you to press enter. However, option two will"
        print "use all the processor power it can get, whereas option one uses"
        print "very little. Note that during the game pressing t toggles these"
        print "modes. Please enter 1 or 2. If you do not your current choice"
        print "will remain."
        input "";l
        if l=1 or l=2 then inputMode=l
        goto[mainMenu]
    end if

[nextPiece]
    done=0
    rotating=0
    nextPiece=val(left$(list$, 1))
    list$=right$(list$, 5)+str$(int(rnd(1)*7)+1)
    rotate$=pieces$(nextPiece)
    curUpLeftX=4
    curUpLeftY=0
    curRot=0
    lines=0
    for i=1 to 4
        curX=val(mid$(rotate$, i*2-1, 1))-1
        curY=val(mid$(rotate$, i*2, 1))-1
        if grid(curUpLeftX+curX, curUpLeftY+curY+1)=1 then lost=1
    next
    if lost=1 then goto[lost]

[redoit]
    emptyLine=0
    for i=20 to 1 step -1
        empty=0
        for x=1 to 10
            if grid(x, i)=0 then
                empty=1
                exit for
            end if
        next
        if empty=0 then
            emptyLine=1
            lines=lines+1
            score=score+lines
            which=i
            for x=1 to 10
                grid(x, i)=0
            next
            exit for
        end if
    next
    if emptyLine=1 then
        for i=which to 1 step -1
            for x=1 to 10
                grid(x, i)=grid(x, i-1)
            next
        next
        goto[redoit]
    end if

[frameUp]
    for i=1 to 4
        curX=val(mid$(rotate$, i*2-1, 1))-1
        curY=val(mid$(rotate$, i*2, 1))-1
        grid(curUpLeftX+curX, curUpLeftY+curY)=0
        if grid(curUpLeftX+curX, curUpLeftY+curY+1)=1 then done=1
    next
    if done=1 then
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))-1
            curY=val(mid$(rotate$, i*2, 1))-1
            grid(curUpLeftX+curX, curUpLeftY+curY)=1
        next
        goto[nextPiece]
    end if
    curUpLeftY=curUpLeftY+1
    for i=1 to 4
        curX=val(mid$(rotate$, i*2-1, 1))-1
        curY=val(mid$(rotate$, i*2, 1))-1
        grid(curUpLeftX+curX, curUpLeftY+curY)=2
    next

[redo]
    cls
    call draw
    if inputMode=1 then input "What to do? s is down, w is rotate, a is left, d is right.";key$
    if inputMode=2 then
        print "What to do? s is down, w is rotate, a is left, d is right."
        key$=input$(1)
    end if
    key$=lower$(key$)
    if instr(key$, "t")>0 then inputMode=3-inputMode
    if instr(key$, "s")>0 then goto[frameUp]
    if instr(key$, "w")>0 then
        rotating=rotating+1
        new$=rotate$(nextPiece, rotating)
        rotatel$=mid$(new$, 1, 1)+mid$(new$, 3, 1)+mid$(new$, 5, 1)+mid$(new$, 7, 1)
        oldulx=curUpLeftX
        olduly=curUpLeftY
        if curUpLeftX>9 and instr(rotatel$, "2")>0 then curUpLeftX=9
        if curUpLeftX>8 and instr(rotatel$, "3")>0 then curUpLeftX=8
        if curUpLeftX>7 and instr(rotatel$, "4")>0 then curUpLeftX=7
        for q=0 to 3
            experCur=curUpLeftY-q
            bad=0
            for i=1 to 4
                curX=val(mid$(new$, i*2-1, 1))-1
                curY=val(mid$(new$, i*2, 1))-1
                if grid(curUpLeftX+curX, experCur+curY)=1 then bad=1
            next
            if bad=0 then
                curUpLeftY=experCur
                for i=1 to 4
                    oldX=val(mid$(rotate$, i*2-1, 1))-1
                    oldY=val(mid$(rotate$, i*2, 1))-1
                    grid(oldulx+oldX, olduly+oldY)=0
                next
                rotate$=new$
                for i=1 to 4
                    newX=val(mid$(rotate$, i*2-1, 1))-1
                    newY=val(mid$(rotate$, i*2, 1))-1
                    grid(curUpLeftX+newX, curUpLeftY+newY)=2
                next
                exit for
            end if
        next
        if bad=1 then rotate=rotate-1
    end if
    if instr(key$, "a")>0 then
        curUpLeftX=curUpLeftX-1
        if curUpLeftX=0 then
            curUpLeftX=1
            goto[skipa]
        end if
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))
            curY=val(mid$(rotate$, i*2, 1))-1
            grid(curUpLeftX+curX, curUpLeftY+curY)=0
        next
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))-1
            curY=val(mid$(rotate$, i*2, 1))-1
            grid(curUpLeftX+curX, curUpLeftY+curY)=2
        next
    end if

[skipa]
    if instr(key$, "d")>0 then
        curUpLeftX=curUpLeftX+1
        if curUpLeftX>10 then goto[dropIn]
        rotatel$=mid$(rotate$, 1, 1)+mid$(rotate$, 3, 1)+mid$(rotate$, 5, 1)+mid$(rotate$, 7, 1)
        if curUpLeftX>9 and instr(rotatel$, "2")>0 then goto[dropIn]
        if curUpLeftX>8 and instr(rotatel$, "3")>0 then goto[dropIn]
        if curUpLeftX>7 and instr(rotatel$, "4")>0 then

[dropIn]
            curUpLeftX=curUpLeftX-1
            goto[skipb]
        end if
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))-1
            curY=val(mid$(rotate$, i*2, 1))-1
            if grid(curUpLeftX+curX, curUpLeftY+curY)=1 then bad=1
        next
        if bad=1 then
            bad=0
            goto[skipb]
        end if
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))-2
            curY=val(mid$(rotate$, i*2, 1))-1
            grid(curUpLeftX+curX, curUpLeftY+curY)=0
        next
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))-1
            curY=val(mid$(rotate$, i*2, 1))-1
            grid(curUpLeftX+curX, curUpLeftY+curY)=2
        next
    end if

[skipb]
    if readyDrop=1 then
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))-1
            curY=val(mid$(rotate$, i*2, 1))-1
            if grid(curUpLeftX+curX, curUpLeftY+curY+1)=1 then stopping=1
        next
        for i=1 to 4
            curX=val(mid$(rotate$, i*2-1, 1))-1
            curY=val(mid$(rotate$, i*2, 1))-1
            grid(curUpLeftX+curX, curUpLeftY+curY)=stopping
            if stopping=0 then grid(curUpLeftX+curX, curUpLeftY+curY+1)=2
            curUpLeftY=curUpLeftY+1
        next
        if stopping=1 then
            stopping=0
            goto[nextPiece]
        end if
    end if
    goto[redo]

[lost]
    cls
    for i=1 to 8
        text$=space$(8-i)+left$("YOU LOSE", i)
        call textrisText text$
        timer 500, [loopAround2]
        wait

[loopAround2]
        timer 0
        cls
    next
    for i=1 to 3
        call textrisText "        "
        timer 300, [next3]
        wait

[next3]
        timer 0
        cls
        call textrisText "YOU LOSE"
 
User IP Logged

SirDavid
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 216
xx Re: Text - Based Challenge
« Reply #23 on: Jul 24th, 2008, 11:09am »

Code:
        timer 300, [next4]
        wait
        mainwin 70 25

[next4]
        cls
        timer 0
    next
    input "Press Y to play again, anything else to exit.";again$
    if left$(upper$(again$), 1)="Y" then goto[mainMenu]
    print "Press alt-f4 to exit."
    end

sub draw
    cls
    for y=1 to 20
        for x=1 to 10
            if grid(x, y)>0 then grid$=grid$+"X" else grid$=grid$+" "
        next
        grid$=grid$+chr$(13)
    next
    grid$=grid$+"OOOOOOOOOO"+chr$(13)
    print grid$
    locate 12, 1
    print "Score: ";str$(score)
    locate 12, 2
    print "Next"
    for i=3 to 18 step 3
        locate 12, i
        curPiece$=mid$(list$, i/3, 1)
        show$=pieces$(val(curPiece$))
        for a=1 to 4
            curX=val(mid$(show$, a*2-1, 1))-1
            curY=val(mid$(show$, a*2, 1))-1
            locate 12+curX, i+curY
            print "X"
        next
    next
    locate 1, 22
end sub

sub nextFrame
    readyDrop=1
end sub

function rotate$(pieceNum, rotations) 'Rotate clockwise
    if pieceNum=1 and rotations mod 2=0 then rotate$="11213141"
    if pieceNum=1 and rotations mod 2=1 then rotate$="11121314"
    if pieceNum=2 and rotations mod 4=0 then rotate$="11122232"
    if pieceNum=2 and rotations mod 4=1 then rotate$="11121321"
    if pieceNum=2 and rotations mod 4=2 then rotate$="11213132"
    if pieceNum=2 and rotations mod 4=3 then rotate$="13212223"
    if pieceNum=3 and rotations mod 4=0 then rotate$="12223132"
    if pieceNum=3 and rotations mod 4=1 then rotate$="11121323"
    if pieceNum=3 and rotations mod 4=2 then rotate$="11122131"
    if pieceNum=3 and rotations mod 4=3 then rotate$="11212223"
    if pieceNum=4 then rotate$="11122122"
    if pieceNum=5 and rotations mod 2=0 then rotate$="12212232"
    if pieceNum=5 and rotations mod 2=1 then rotate$="11122223"
    if pieceNum=6 and rotations mod 4=0 then rotate$="12212232"
    if pieceNum=6 and rotations mod 4=1 then rotate$="11121322"
    if pieceNum=6 and rotations mod 4=2 then rotate$="11212231"
    if pieceNum=6 and rotations mod 4=3 then rotate$="12212223"
    if pieceNum=7 and rotations mod 2=0 then rotate$="11212232"
    if pieceNum=7 and rotations mod 2=1 then rotate$="12132122"
end function

sub textrisText text$
    text$=upper$(text$)
    for i=1 to len(text$)
        curLetter$=mid$(text$, i, 1)
        if curLetter$=" " then goto[noletter]
        if curLetter$="T" then pos=1
        if curLetter$="E" then pos=2
        if curLetter$="X" then pos=3
        if curLetter$="R" then pos=4
        if curLetter$="I" then pos=5
        if curLetter$="S" then pos=6
        if curLetter$="Y" then pos=7
        if curLetter$="O" then pos=8
        if curLetter$="U" then pos=9
        if curLetter$="L" then pos=10
        xPos=(i-1)*6+1
        posShow$=letterTemplates$(pos)
        for x=1 to len(posShow$)/2
            curX=val(mid$(posShow$, x*2-1, 1))-1
            curY=val(mid$(posShow$, x*2, 1))-1
            locate xPos+curX, 1+curY
            print gridTemplate$(xPos+curX, 1+curY)
        next

[noletter]
    next
end sub
 

There you go! It's a Tetris clone (well not quite, real-time is impossible so it's more like a puzzle game) called (I deserve to be kicked out of the competition for this) Textris. Enjoy!
« Last Edit: Jul 24th, 2008, 5:21pm by SirDavid » User IP Logged

mylifedrive
Full Member
ImageImageImageImage


member is offline

Avatar

Encountering Errors


Homepage PM

Gender: Male
Posts: 179
xx Re: Text - Based Challenge
« Reply #24 on: Jul 24th, 2008, 1:40pm »

BUG:

The pieces don't automatically fall, you have to push d to make them go down, so basically you are just stacking blocks.

Quote:
real-time is impossible so it's more like a puzzle game


or is it not a bug?
« Last Edit: Jul 24th, 2008, 1:41pm by mylifedrive » User IP Logged

Just Basic is the BEST FREE BASIC AROUND!
SirDavid
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 216
xx Re: Text - Based Challenge
« Reply #25 on: Jul 24th, 2008, 3:22pm »

Well, I don't really know whether to call it a bug or not. Certainly I would have preferred to make it real-time, but I made part of the program while understanding that this would be impossible. Obviously it isn't an exact Tetris clone, but I didn't want to make an exact clone, just something that is recognizable as a Tetris style game was fine with me. Wiktionary's definition of a bug is "A problem that needs fixing, especially in computing" but as it's still recognizable as Tetris style I don't know if it needs fixing, especially as I understood while writing it that it would be impossible to make an exact clone.
User IP Logged

Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1310
xx Re: Text - Based Challenge
« Reply #26 on: Jul 24th, 2008, 3:42pm »

Is not a bug. It's Textris ;D
Coming soon: Pac-Main
Little intro Code:
pac$="C G 0 G"
ghost$="n ń"
title$ = "PAC-MAiN";_
": Text - Based Challenge"
mainwin 35 3
for i = 1 to 20
    scan
    t = time$("ms")+70
    while time$("ms") < t : wend
    locate 0,0
    a = abs(not(a))
    if a=0 Then s=s+1 : s$=space$(s)
    g$ = word$(ghost$,a+1);" "
    b=b+1 : if b>4 Then b=1
    Print s$;word$(pac$,b);"    ";g$;g$;g$
next
CLS
for i= 1 to len(title$)
    scan
    t = time$("ms")+100
    while time$("ms") < t : wend
    Print mid$(title$,i,1);
next
END 

This is not my entry, just the intro.
User IP Logged

cundo aka MSlayer
Welopez
Moderator
ImageImageImageImageImage


member is offline

Avatar

Never let your beliefs get in the way of learning.


PM

Gender: Male
Posts: 4407
xx Re: Text - Based Challenge
« Reply #27 on: Jul 24th, 2008, 5:13pm »

Sir David: You wrote...
Code:
    input "Press Y to play again, anything else to exit. "; again$
    if left$(lower$(again$), 1)="Y" then goto[mainMenu]
 

How can LEFT$(LOWER$(again$),1)="Y"? Just checking to see if you know someting I may have forgotten.

It works for me if I use:
Code:
if left$(again$, 1)="Y" then goto[mainMenu]
 

...or...
Code:
if left$(lower$(again$), 1)="y" then goto[mainMenu]
 

... but always goes to Press Alt-F4 to exit the way you have it written.
User IP Logged

JB 1.01
Win7 64bit, 4 GB RAM, Pentium 6200@2.13 GHz (laptop)
WinXP, 1 GB RAM, Intel N270@1.6 GHz (netbook)
SirDavid
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 216
xx Re: Text - Based Challenge
« Reply #28 on: Jul 24th, 2008, 5:21pm »

Oh, thanks! I don't know what I was thinking. Above code edited.
« Last Edit: Jul 24th, 2008, 5:22pm by SirDavid » User IP Logged

Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1310
xx Re: Text - Based Challenge
« Reply #29 on: Jul 24th, 2008, 6:21pm »

I'm going to post the code, because my HD is giving me problems again (just in case I lost the code after executing CHKDSK).
I think it can be trimmed down. This program uses input$(1), so it will take 100% of the processor while waiting for input.
The game is like pacman, but simpler , no real time.

Code:
' jb mainwin
' pac-main
' cundo 2008
    on error goto [Error]
'Dim double array
    dim map$(19,23),start(4,2)
    difficulty = 3 ' 1 to 10
    lives=3
    r$="STARTING"
    alternateMov = 1
    mainwin 50 25
'Print a message to the Mainwin
    Print "Press ";chr$(34);"q";chr$(34);" to quit"
    Print "Movement keys: W,A,S,D, or 8,4,6,2 "
    Print "Press any key to start",
    if lower$(input$()) = "q" Then [quit]
    gosub [restartscreen]
    r$="RE";r$
'Store the data in the array
    read height : read width : read wall$
    read player$ : read ghost$ : read sghost$
    read power$
    b$ = wall$ 'walls
    dots$ = chr$(186) 'change this to "*" or "." if you want
    for i= 1 to height
        read map$
        for u= 1 to width
            map$(i,u) = mid$(map$,u,1)
            Select case map$(i,u)
                Case " ","t","-"
                If map$(i,u)="t" Then t=i
                a = abs(not(a))
                if a= 0 Then
                    max.points = max.points+1
                    map$(i,u) = dots$
                End if
                Case power$
                p= p+1
                power(p,0)=u : power(p,1)=i
                Case player$
                start(0,1)=u : start(0,2)=i
                map$(i,u) = " "
                Case ghost$
                g=g+1
                start(g,1)=u : start(g,2)=i
                map$(i,u) = " "
            End select
        next u
    next i

[restart]
    h=0
    scared=0
    player.x=start(0,1) : player.y=start(0,2)
    for i= 1 to g
        ghost.x(i) =start(i,1) : ghost.y(i) =start(i,2)
    next i

[reprint]
    temp$= ""
    mapscreen$= ""
'put the data in the mapscreen$ var
    for i= 1 to height
        for u= 1 to width
            temp$=mapscreen$;map$(i,u)
            if i = player.y and u = player.x Then
                temp$= mapscreen$;player$
            End if
            for z= 1 to g
                ghost.y=ghost.y(z) : ghost.x = ghost.x(z)
                if i = ghost.y and u = ghost.x Then
                    if scared>0 Then
                        temp$= mapscreen$;sghost$
                    else
                        temp$= mapscreen$;ghost$
                    end if
                End if
            next
            mapscreen$ = temp$
        next u
        mapscreen$=mapscreen$ + chr$(13)
    next i
'show me the level
    cls
    scoreScreen=score + extraPoints
    score$ = using("###",scoreScreen)
    print mapscreen$, "Score: ";score$;" Lives: ";lives
    If score=max.points or g = 0 Then [win]
    if scared>0 Then
        scared=scared - 1
    End if
    print "ghosts scared ";scared
    for z = 1 to g
        ghost.y=ghost.y(z) : ghost.x = ghost.x(z)
        If player.x = ghost.x And player.y = ghost.y And lives>0 Then
            If scared=0 Then [lose]
            extraPoints=extraPoints+10
            r$="Good"
            locate 23,10: Print "10 Points"
            locate 23,11
            gosub [restartscreen]
            r$="RESTARTING"
            locate 0,0
'the ghost appear in the box
            ghost.x(z) = start(z,1) : ghost.y(z)=start(z,2)
'the ghost disappear
'z was removed
'remove the last ghost, move the others in the array.
' r = g-z
' ghost.y(g-r)=ghost.y(g)
' ghost.x(g-r)=ghost.x(g)
' g=g-1
        End if
    next z
'player movement
    key$=""
    key$ = input$(1)
    select case key$
        case "6","d","D"
        if map$(player.y, player.x+1)<>b$  Then
            player.x = player.x+1
            if player.x >=width and player.y=t Then player.x = 1
        End if
        case "4","a","A"
        if map$(player.y, player.x-1)<>b$  Then
            player.x = player.x-1
            if player.x <=0 and player.y=t Then player.x =width
        End if
        case "8","w","W"
        if map$(player.y-1, player.x)<>b$  Then
            player.y = player.y-1
        End if
        case "2","s","S"
        if map$(player.y+1, player.x)<>b$  Then
            player.y = player.y+1
        End if
        case "q","Q"
        goto [quit]
    end select
    if map$(player.y, player.x)=dots$ then map$(player.y, player.x)=" " : score=score+1
    if map$(player.y, player.x)=power$ then
        map$(player.y, player.x)=" " ': score=score+1
        extraPoints= extraPoints +5
        scared= 22
    End if
'Ghost moves
    if h<=2 then h= h+ 0.025
    for z = 1 to g
        ghost.y=ghost.y(z) : ghost.x = ghost.x(z)
        new.x(z)=0:new.y(z)=0
        If INT(rnd(1)*11)>INT(difficulty+h) OR _
        (ABS(player.x-ghost.x)>5 and ABS(player.y-ghost.y)>5) Then
        alternateMov = -1 * alternateMov
        If map$(ghost.y+alternateMov, ghost.x)=b$ Then
            if map$(ghost.y, ghost.x+alternateMov)=b$ Then
                if map$(ghost.y+alternateMov*-1, ghost.x)=b$ Then
                    if map$(ghost.y, ghost.x+alternateMov*-1)=b$ Then
                        new.x(z)= alternateMov
                    else
                        new.x(z)=alternateMov*-1
                    End if
                else
                    new.y(z)=alternateMov*-1
                End if
            else
                new.x(z)=alternateMov
            End if
        else
            new.y(z)=alternateMov
        End if
    Else
'Check player position and move according
        if scared >0 Then m=-1 else m=1
        if player.y>ghost.y Then
            If map$(ghost.y +1*m, ghost.x)<>b$ Then new.y(z)= 1*m
        else
            If map$(ghost.y -1*m, ghost.x)<>b$ Then new.y(z)=-1*m
        End if
        if player.x>ghost.x Then
            If map$(ghost.y, ghost.x +1*m)<>b$ Then new.x(z)= 1*m
        else
            If map$(ghost.y, ghost.x -1*m)<>b$ Then new.x(z)=-1*m
        End if
    End if
    If (ghost.y=10 AND ghost.x=11) OR (ghost.y=9 AND ghost.x=11) Then
        new.y(z)=-1 : new.x(z)=0
    Else
        If INT(rnd(0)*10)>5 Then new.y(z)=0 else new.x(z)=0
    End if
    If ghost.y=10 Then
        if ghost.x<=1 then new.x(z)=1
        if ghost.x>=width then new.x(z)=-1
    End if
    ghost.x(z)= ghost.x(z) + new.x(z)
    ghost.y(z)= ghost.y(z) + new.y(z)
    next z
    Goto [reprint]

[lose]
    lives = lives -1
    locate 23,10
    Print "Oops!"
    if lives <=0 Then [quit]
    key$=input$(1)
    locate 23,11
    gosub [restartscreen]
    cls:locate 0,0
    goto [restart]

[win]
    Print "Yeah!"+chr$(13)+"Level complete."
    Print "Lives ";lives
    Print "Score ";score+extraPoints
    END

[Error]
    Print
    print "Error",Err$

[quit]
    if lives<=0 Then Cls : Print "------- LOSER -------"
    Print chr$(13); "---------------------";chr$(13);"------  Bye!  -------"
    Print "---------------------"
    END

[restartscreen]
    for i = 1 To len(r$)
        pause = time$("ms")+100
        while time$("ms") < pause : wend
        Print mid$(r$,i,1);
    next i
    return
'level data,
'height, width, walls, player, ghost, PacPowerPill, map
    data 19,21
    data "#","O","n","ń","@"
    data "#####################"
    data "#@      #####      @#"
    data "# ##### ##### ##### #"
    data "#     # ##### #     #"
    data "## ## #       # ## ##"
    data "##      #####      ##"
    data "##### #   #   # #####"
    data "##### #       # #####"
    data "##### # ##-## # #####"
    data "t       #nnn#        "
    data "##### # ##### # #####"
    data "##### #       # #####"
    data "#####   #####   #####"
    data "#     #   #   #     #"
    data "#@ ## # #   # # ## @#"
    data "##    # ## ## #    ##"
    data "## #### ## ## ###  ##"
    data "##        O        ##"
    data "#####################" 

User IP Logged

cundo aka MSlayer
Pages: 1 2 3 4  5 Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls