Qbasicnews.com

QbasicNews.Com => Challenges => Topic started by: seph on May 25, 2003, 02:31:28 PM



Title: New Challenge for hardcore QBers
Post by: seph on May 25, 2003, 02:31:28 PM
You must make a Qbasic game. Here are the rules:

- No libraries
- Qbasic 4.5 only!
- 64 lines long MAX :)

Have fun!


Title: New Challenge for hardcore QBers
Post by: Agamemnus on May 25, 2003, 03:31:26 PM
impossible.


Title: New Challenge for hardcore QBers
Post by: seph on May 25, 2003, 03:33:02 PM
Or is it?

Code:
SCREEN 7, , 0, 1
LINE (0, 0)-(319, 199), 1, B
LINE (1, 1)-(318, 198), 9, B
LINE (2, 2)-(317, 197), 1, B

x% = 160
y% = 100

ex% = 10
ey% = 10
et% = 0

DO
        et% = et% + 1
        oldx% = x%
        oldy% = y%

        oldex% = ex%
        oldey% = ey%

        key$ = INKEY$

        SELECT CASE key$
        CASE CHR$(0) + CHR$(72):
                IF POINT(x%, y% - 5) = 0 THEN y% = y% - 3
        CASE CHR$(0) + CHR$(80):
                IF POINT(x%, y% + 4) = 0 THEN y% = y% + 3
        CASE CHR$(0) + CHR$(75)
                IF POINT(x% - 5, y%) = 0 THEN x% = x% - 3
        CASE CHR$(0) + CHR$(77)
                IF POINT(x% + 4, y%) = 0 THEN x% = x% + 3
        END SELECT

        IF et% = 6 THEN
                IF INT(RND * 4) MOD 3 AND ex% > x% AND POINT(ex% - 5, ey%) = 0 THEN ex% = ex% - 3
                IF INT(RND * 4) MOD 3 AND ex% < x% AND POINT(ex% + 4, ey%) = 0 THEN ex% = ex% + 3
                IF INT(RND * 4) MOD 3 AND ey% > y% AND POINT(ex%, ey% - 5) = 0 THEN ey% = ey% - 3
                IF INT(RND * 4) MOD 3 AND ey% < y% AND POINT(ex%, ey% + 4) = 0 THEN ey% = ey% + 3
                et% = 0
        END IF

        IF ABS(ex% - x%) <= 3 AND ABS(ey% - y%) <= 3 THEN
                'CLS
                LOCATE 13, 6
                PRINT "You lost, loser! Mwahahahaha!"
                PCOPY 0, 1
                SLEEP
                CLS
                END
        END IF

        LINE (oldx% - 2, oldy% - 2)-(oldx% + 2, oldy% + 2), 0, BF
        CIRCLE (x%, y%), INT(TIMER MOD 1.5) + 1, 10
        PAINT (x%, y%), 2, 10

        LINE (oldex% - 2, oldey% - 2)-(oldex% + 2, oldey% + 2), 0, BF
        CIRCLE (ex%, ey%), INT(TIMER MOD 1.5) + 1, 12
        PAINT (ex%, ey%), 4, 12

        PCOPY 0, 1
LOOP UNTIL key$ = CHR$(27)


Title: New Challenge for hardcore QBers
Post by: Ninkazu on May 25, 2003, 03:46:07 PM
Dude.... that's so cool, but would be better if there was a score.


Title: New Challenge for hardcore QBers
Post by: toonski84 on May 25, 2003, 04:12:51 PM
it's not impossible (i've seen a 13 line snake and a 9 line pong), but i dont really feel like it, my "hardcore" qb days are long gone :P  alls i want to do nowadays is just make sprites and enter littler, happy contests.


Title: New Challenge for hardcore QBers
Post by: seph on May 25, 2003, 04:39:18 PM
I'm planning on implimenting randomly placed "coins" that you have to collent in order to get a score... But meh...


Title: My less-than-64-line game.
Post by: Meg on May 25, 2003, 09:37:54 PM
Here's something I threw together.  There's plenty of lines to spare, and lots of ways to crunch down on the size of this and get even more lines.  But I've been sittin' at the computer all day and need a break.  So here ya go:

Keep the hero alive.  Red pellets slow the enemy.  Purple pellets speed you up.  Brown pellets clear the screen (very useful)

Have fun!

Code:
RANDOMIZE TIMER
DEF SEG = 0
SCREEN 13
LINE (0, 0)-(319, 199), 1, B
x! = 160
y! = 100
s! = .001
bs! = .0006
t# = TIMER
PSET (160, 100), 15
DO
     DO
          IF INT(RND * 100000) = 1 AND bs! < s! THEN bs! = bs! + .00001
          IF INT(RND * 9000) = 1 THEN
               dx% = INT(RND * 320)
               dy% = INT(RND * 200)
               IF ABS(x! - dx%) > 5 AND ABS(y! - dy%) > 5 THEN PSET (INT(RND * 320), INT(RND * 200)), 1
          END IF
          b% = POINT(bx! + bxc!, by! + byc!)                'get next color
          bx! = bx! + bxc!                                  'move baddy
          by! = by! + byc!                                  'move baddy
          IF b% <> 1 THEN PSET (bx!, by!), 1                'draw baddy
          bxc! = SGN(x! - bx!) * bs! * COS(ATN(ABS(y! - by!) / ABS(x! - bx!)))
          byc! = SGN(y! - by!) * bs! * SIN(ATN(ABS(y! - by!) / ABS(x! - bx!)))
          n% = POINT(x! + xc!, y! + yc!)                    'get next color
          IF n% <> 15 THEN PSET (x!, y!), 1                 'make trail
          x! = x! + xc!                                     'move hero
          y! = y! + yc!                                     'move hero
          IF n% = 4 OR n% = 5 OR n% = 6 OR b% = 4 OR b% = 5 OR b% = 6 OR INT(RND * 100000) = 1 THEN
               IF cx% OR cy% THEN CIRCLE (cx%, cy%), 1, 0
               cx% = INT(RND * 316) + 2
               cy% = INT(RND * 196) + 2
               CIRCLE (cx%, cy%), 1, INT(RND * 3) + 4
          END IF
          IF n% = 4 THEN bs! = .0005
          IF n% = 5 THEN s! = s! + .0001
          IF n% = 6 THEN
               CLS
               LINE (0, 0)-(319, 199), 1, B
               PSET (x!, y!), 15
               CIRCLE (cx%, cy%), 1, INT(RND * 3) + 4
          END IF
          IF n% <> 1 THEN PSET (x!, y!), 15                 'draw hero
          POKE &H41A, PEEK(&H41C)                           'clear kb buffer
          k% = INP(&H60)                                    'get keystroke
     LOOP UNTIL k% = 72 OR k% = 75 OR k% = 80 OR k% = 77 OR k% = 1 OR n% = 1
     xc! = 0
     yc! = 0
     IF k% = 72 THEN yc! = -s!
     IF k% = 75 THEN xc! = -s!
     IF k% = 80 THEN yc! = s!
     IF k% = 77 THEN xc! = s!
LOOP UNTIL k% = 1 OR n% = 1
PRINT "You scored"; INT(TIMER - t# + .5); "points!"


*peace*

Meg.


Title: New Challenge for hardcore QBers
Post by: Ninkazu on May 25, 2003, 10:51:46 PM
Very nice! I love snake clones :)


Title: New Challenge for hardcore QBers
Post by: relsoft on May 26, 2003, 12:41:19 AM
PacMan!!! Anyone????


Title: New Challenge for hardcore QBers
Post by: Ninkazu on May 26, 2003, 12:53:08 AM
Pac man? I just finished helping a dude with that, but it's well over 64 lines..... still wanna see it?


Title: New Challenge for hardcore QBers
Post by: relsoft on May 26, 2003, 01:14:13 AM
Yeah. :*)


Title: New Challenge for hardcore QBers
Post by: Ninkazu on May 26, 2003, 01:23:00 AM
Note, all I did was help add multiple enemies and add buffering to eliminate flicker. I don't create such horrible code.

Ok... let the mongoose ride! (whatever that means)
Code:
DEFINT A-Z
'$DYNAMIC
DECLARE SUB Enemylogic (enemyNum AS INTEGER)
DECLARE SUB Move ()
DECLARE SUB pacman ()
DECLARE SUB Maploader ()
DECLARE SUB YouLose ()
DECLARE SUB YouWin ()
DECLARE SUB nPrint (xx%, yy%, Text$, col%)
DECLARE SUB Pixel (xx%, yy%, cc%)
DECLARE SUB Intro ()
DECLARE SUB anykey ()
DECLARE SUB SpriteS (Sprite(), xx, yy, frame)
DIM SHARED lutsegy(199) AS LONG
DIM SHARED buffer(32001) AS INTEGER
DIM SHARED time#
SCREEN 12

buffer(0) = 2560: buffer(1) = 200

FOR n& = 0 TO 199
  lutsegy(n&) = n& * 320 + 4
NEXT

CLS

'************** MAP VARIABLES **************
'*******************************************
'**                                       **
'** 0 = Brick (normal)                    **
'** 1 = Brick (open at left)              **
'** 2 = Brick (open at top)               **
'** 3 = Brick (open at right)             **
'** 4 = Brick (open at bottom)            **
'** 5 = Brick (open at top and left)      **
'** 6 = Brick (open at top and right)     **
'** 7 = Brick (open at bottom and right)  **
'** 8 = Brick (open at bottom and left)   **
'** 9 = Background                        **
'**                                       **
'*******************************************
'*******************************************

DIM SHARED Map%(0 TO 15, 0 TO 9)
DIM SHARED posX%
DIM SHARED posY%
DIM SHARED brick0%(210)
DIM SHARED brick1%(210)
DIM SHARED brick2%(210)
DIM SHARED brick3%(210)
DIM SHARED brick4%(210)
DIM SHARED brick5%(210)
DIM SHARED brick6%(210)
DIM SHARED brick7%(210)
DIM SHARED brick8%(210)
DIM SHARED brick10%(210)
DIM SHARED brick11%(210)
DIM SHARED background%(210)
DIM SHARED char(210) AS INTEGER
DIM SHARED enemy(210) AS INTEGER
DIM SHARED MaxEnemies AS INTEGER, MaxPellets AS INTEGER, PelletCounter AS INTEGER
MaxEnemies = 5
TYPE EnemyType
x AS INTEGER
y AS INTEGER
END TYPE
DIM SHARED Enemies(1 TO MaxEnemies) AS EnemyType

TYPE PelletType
x AS INTEGER
y AS INTEGER
state AS INTEGER
END TYPE

CALL Intro

Menu: CLS
COLOR 4
PRINT
PRINT
PRINT
PRINT
PRINT "             ___                  __"
PRINT "            (  _`\              (  _`\                         "
PRINT "            | |_) )  _ _    ___ | | ) |   _ _  _   _   _    __ "
COLOR 15
PRINT "            | ,__/'/'_` ) /'___)| | | ) /'_` )( ) ( ) ( ) /'_ `\"
COLOR 2
PRINT "            | |   ( (_| |( (___ | |_) |( (_| || \_/ \_/ |( (_) |"
PRINT "            (_)   `\__,_)`\____)(____/'`\__,_)`\___/\__/'`\__  |"
PRINT "                                                         ( )_) |"
PRINT "                                                          \___/'"
WHILE choice <> 5
PRINT
PRINT
COLOR 1
LOCATE 17, 1
PRINT TAB(20); "    浜様様様様様様様様様様様様"
PRINT TAB(20); "                             "
PRINT TAB(20); "                             "
PRINT TAB(20); "                             "
PRINT TAB(20); "                             "
PRINT TAB(20); "                             "
PRINT TAB(20); "    藩様様様様様様様様様様様様"
'***
COLOR 4
LOCATE 18, 28
PRINT "1.) New Game"
LOCATE 19, 28
PRINT "2.) Load Game"
LOCATE 20, 28
PRINT "3.) Instructions"
LOCATE 21, 28
PRINT "4.) High Scores"
LOCATE 22, 28
PRINT "5.) Quit"


'***
COLOR 4

PRINT
PRINT
PRINT
PRINT
COLOR 2
INPUT "Please ENTER 1-5 -> ", choice
COLOR 15

SELECT CASE choice
CASE 1
GOTO newgame
'CASE 2

CASE 3
GOTO Instructions
CASE 4
'CALL PrintHS

CASE 5
END

CASE ELSE
PRINT "Please Enter 1-5"
SLEEP 1
GOTO Menu
END SELECT
WEND

Instructions: CLS
COLOR 4
PRINT TAB(23); "INSTRUCTIONS"
PRINT ""
COLOR 2
PRINT "KEYS"
PRINT ""
COLOR 15
PRINT "MOVEMENT -> Use the LEFT, RIGHT, UP and DOWN arrow keys on the keyboard"
PRINT "QUIT -> Press ESC to quit at any time"
COLOR 2
PRINT ""
PRINT ""
PRINT "GAMEPLAY"
PRINT ""
COLOR 15
PRINT "The object of the game is to collect as many pellets as you can while"
PRINT "avoiding the scary ghosts. Keep in mind that the ghosts can appear,"
PRINT "disappear, and multiply at any time. The more pellets you collect, the"
PRINT "more points you gain. Each pellet can have a different value from 1 to 5"
PRINT "points. Since you are also being timed, the faster you can collect the"
PRINT "pellets, the better."
PRINT
COLOR 2
PRINT "GOOD LUCK"
CALL anykey
GOTO Menu


SCREEN 13

pelletcount = 0

newgame: FOR y = 0 TO 9
FOR x = 0 TO 15
READ Map%(x, y)
IF Map%(x, y) = 9 THEN pelletcount = pelletcount + 1
NEXT x
NEXT y
DIM SHARED pellets(pelletcount) AS PelletType
MaxPellets = pelletcount
J = 0
FOR y = 0 TO 9
  FOR x = 0 TO 15
IF Map%(x, y) = 9 THEN
pellets(J).x = x
pellets(J).y = y
pellets(J).state = 1
J = J + 1
END IF
  NEXT
NEXT
time# = TIMER
SCREEN 13
DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 2,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2
DATA 2,9,7,8,9,0,9,7,8,9,0,9,7,8,9,2
DATA 2,9,0,1,9,9,9,0,1,9,9,9,0,1,9,2
DATA 2,9,9,9,9,0,9,9,9,9,0,9,9,9,9,2
DATA 2,9,4,9,3,6,0,9,9,3,2,1,9,4,9,2
DATA 2,9,4,9,9,9,9,9,9,9,9,9,9,4,9,2
DATA 2,9,3,3,3,0,9,3,1,9,0,1,1,1,9,2
DATA 2,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2
DATA 2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,5


CALL Maploader
CALL Move

SUB anykey
'***ANYKEY***
COLOR 15
LOCATE 23, 20
PRINT "Type any key to continue"
WHILE INKEY$ = ""
WEND
END SUB

REM $DYNAMIC
SUB Enemylogic (enemyNum AS INTEGER)
'*****************START ENEMY MOVEMENT***********************
'******Change Speed of Enemies
RANDOMIZE TIMER
go = INT(RND * 25) + 1

RANDOMIZE TIMER
mover = INT(RND * 4) + 1

IF go <> 1 THEN mover = 0
inc = 1
SELECT CASE mover
'**RIGHT**
CASE 1
IF Map%(Enemies(enemyNum).x + 1, Enemies(enemyNum).y) = 9 THEN
  GOSUB tileload2b
  Enemies(enemyNum).x = Enemies(enemyNum).x + 1
END IF
'**LEFT**
CASE 2
IF Map%(Enemies(enemyNum).x - 1, Enemies(enemyNum).y) = 9 THEN
  GOSUB tileload2b
  Enemies(enemyNum).x = Enemies(enemyNum).x - 1
END IF
'**DOWN**
CASE 3
IF Map%(Enemies(enemyNum).x, Enemies(enemyNum).y + 1) = 9 THEN
  GOSUB tileload2b
  Enemies(enemyNum).y = Enemies(enemyNum).y + 1
END IF
'**UP**
CASE 4
IF Map%(Enemies(enemyNum).x, Enemies(enemyNum).y - 1) = 9 THEN
  GOSUB tileload2b
  Enemies(enemyNum).y = Enemies(enemyNum).y - 1
END IF
END SELECT

EXIT SUB
tileload2b:
x = Enemies(enemyNum).x
y = Enemies(enemyNum).y
IF Map%(x, y) = 0 THEN
  SpriteS brick0%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 1 THEN
  SpriteS brick1%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 2 THEN
  SpriteS brick2%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 3 THEN
  SpriteS brick3%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 4 THEN
  SpriteS brick4%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 5 THEN
  SpriteS brick5%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 6 THEN
  SpriteS brick6%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 7 THEN
  SpriteS brick7%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 8 THEN
  SpriteS brick8%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 9 THEN
  SpriteS background%(), x * 20, y * 20, 1
  FOR k% = 0 TO MaxPellets
IF pellets(k%).x = x AND pellets(k%).y = y THEN
 IF pellets(k%).state = 1 THEN Pixel x * 20 + 9, y * 20 + 9, 15
END IF
  NEXT
ELSEIF Map%(x, y) = 10 THEN
  SpriteS brick10%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 11 THEN
  SpriteS brick11%(), x * 20, y * 20, 1
END IF
RETURN
END SUB

REM $STATIC
SUB Intro
SCREEN 12
CLS
LOCATE 13, 33
PRINT "Loading......"
SLEEP 3
CLS
LOCATE 13, 28
PRINT "A CamFizlle Productizzle"
SLEEP 3
CLS
LOCATE 13, 33
PRINT "Presents..."
SLEEP 2
END SUB

REM $DYNAMIC
SUB Maploader

'******************
'*****BRICK #0*****
'******************
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 15
LINE (19, 0)-(19, 19), 15
LINE (19, 19)-(0, 19), 15
LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick0%

LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #1*****
'******************
'***Left Side Open***

'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 15
LINE -(19, 19), 15
LINE -(0, 19), 15
'LINE -(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick1%
LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #2*****
'******************
'***Top Side Open***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
'LINE (0, 0)-(19, 0), 15
LINE (19, 0)-(19, 19), 15
LINE (19, 19)-(0, 19), 15
LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick2%

LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #3*****
'******************
'*** Right Side Open***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 15
'LINE (19, 0)-(19, 19), 15
LINE (19, 19)-(0, 19), 15
LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick3%

LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #4*****
'******************
'***Bottom Side Open***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 15
LINE (19, 0)-(19, 19), 15
'LINE (19, 19)-(0, 19), 15
LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick4%
LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #5*****
'******************
'***Left and Top Open***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
'LINE (0, 0)-(19, 0), 15
LINE (19, 0)-(19, 19), 15
LINE (19, 19)-(0, 19), 15
'LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick5%

LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #6*****
'******************
'***Top and Right Open
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
'LINE (0, 0)-(19, 0), 15
'LINE (19, 0)-(19, 19), 15
LINE (19, 19)-(0, 19), 15
LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick6%

LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #7*****
'******************
'***Bottom and Right Open***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 15
'LINE (19, 0)-(19, 19), 15
'LINE (19, 19)-(0, 19), 15
LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick7%

LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #8*****
'******************
'***Bottom and Left Open***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 15
LINE (19, 0)-(19, 19), 15
'LINE (19, 19)-(0, 19), 15
'LINE (0, 19)-(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 4)-(19, 4), 15
LINE (0, 8)-(19, 8), 15
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (8, 0)-(8, 4), 15
LINE (16, 0)-(16, 4), 15
LINE (4, 4)-(4, 8), 15
LINE (12, 4)-(12, 8), 15
LINE (8, 8)-(8, 12), 15
LINE (12, 8)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick8%

LINE (0, 0)-(19, 19), 0, BF
'**************************************background*******************************
LINE (0, 0)-(19, 19), 0, BF

GET (0, 0)-(19, 19), background%

'******************
'*****BRICK #10****
'******************
'***NORMAL SCORE BRICK***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 7
LINE -(19, 19), 15
LINE -(0, 19), 15
LINE -(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 8)-(19, 8), 7
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (19, 0)-(19, 8), 7
PAINT (4, 4), 7, 7
LINE (8, 9)-(8, 12), 15
LINE (12, 9)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick10%
LINE (0, 0)-(19, 19), 0, BF

'******************
'*****BRICK #11****
'******************
'***SCORE BRICK LEFT SIDE OPEN***
'** Color in Brick Red**
LINE (0, 0)-(19, 19), 4, BF

'** Outline of Brick **
LINE (0, 0)-(19, 0), 7
LINE -(19, 19), 15
LINE -(0, 19), 15
'LINE -(0, 0), 15

'** Detailed Blocks on Brick **
'(4 horizontal white lines)
LINE (0, 8)-(19, 8), 7
LINE (0, 12)-(19, 12), 15
LINE (0, 16)-(19, 16), 15
'** Vertical lines **
LINE (19, 0)-(19, 8), 7
PAINT (4, 4), 7, 7
LINE (8, 9)-(8, 12), 15
LINE (12, 9)-(12, 12), 15
LINE (8, 12)-(8, 16), 15
LINE (16, 12)-(16, 16), 15
LINE (4, 16)-(4, 19), 15
LINE (12, 16)-(12, 19), 15
GET (0, 0)-(19, 19), brick11%
LINE (0, 0)-(19, 19), 0, BF

'********CHARACTER**************
CIRCLE (9, 9), 9, 2, 3.14 / 6, 3.5 * 3.14 / 2
 LINE (16, 7)-(10, 9), 2
 LINE -(16, 12), 2
 PSET (17, 13), 2
 PAINT (9, 9), 2
 PSET (17, 7), 2
 PSET (17, 8), 15
 PSET STEP(-2, 0)
 PSET STEP(0, 1)
 PSET STEP(2, 0)
 PSET STEP(0, -1)
 PSET STEP(-1, 0)
 PSET (13, 8), 0
 PSET STEP(-1, 0), 0
 PSET (12, 5), 0
 PSET STEP(1, 0)
 PSET STEP(-1, 1)
 PSET STEP(-1, -1)
 PSET STEP(1, -1)
GET (0, 0)-(19, 19), char

LINE (0, 0)-(19, 19), 0, BF
'*******enemy************
CIRCLE (9, 9), 3, 40
CIRCLE (5, 6), 2, 31
PAINT (5, 6), 31, 31
CIRCLE (13, 6), 2, 31
PAINT (13, 6), 31, 31
CIRCLE (13, 6), 5, 16
PSET (5, 11)
PSET (13, 11)
LINE (4, 10)-(12, 12)
PSET (15, 12)
GET (0, 0)-(19, 19), enemy

'*****************************************************************************
'******************Assigning above graphics to specific tiles*****************
'*****************************************************************************
FOR y = 0 TO 9
FOR x = 0 TO 15

IF Map%(x, y) = 0 THEN
  SpriteS brick0%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 1 THEN
  SpriteS brick1%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 2 THEN
  SpriteS brick2%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 3 THEN
  SpriteS brick3%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 4 THEN
  SpriteS brick4%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 5 THEN
  SpriteS brick5%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 6 THEN
  SpriteS brick6%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 7 THEN
  SpriteS brick7%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 8 THEN
  SpriteS brick8%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 9 THEN
  SpriteS background%(), x * 20, y * 20, 1
  FOR k% = 0 TO MaxPellets
IF pellets(k%).x = x AND pellets(k%).y = y THEN
 IF pellets(k%).state = 1 THEN Pixel x * 20 + 9, y * 20 + 9, 15
END IF
  NEXT
ELSEIF Map%(x, y) = 10 THEN
  SpriteS brick10%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 11 THEN
  SpriteS brick11%(), x * 20, y * 20, 1
END IF

NEXT x
NEXT y

END SUB

DEFINT A-Z
SUB Move
posX% = 7
posY% = 8

FOR m% = 1 TO MaxEnemies
Enemies(m%).x = 8
Enemies(m%).y = 4
NEXT

DO
inc = 1
SELECT CASE INKEY$
'**RIGHT**
CASE CHR$(0) + "M"
IF Map%(posX% + 1, posY%) = 9 THEN
  GOSUB Tileload
  posX% = posX% + 1
  FOR k% = 0 TO MaxPellets
  IF posX% = pellets(k%).x AND posY% = pellets(k%).y THEN
IF pellets(k%).state = 1 THEN
pellets(k%).state = 0
PelletCounter = PelletCounter + 1
IF PelletCounter = MaxPellets THEN YouWin
END IF
  END IF
  NEXT
  inc = 1
END IF
'**LEFT**
CASE CHR$(0) + "K"
IF Map%(posX% - 1, posY%) = 9 THEN
  GOSUB Tileload
  posX% = posX% - 1
  FOR k% = 0 TO MaxPellets
  IF posX% = pellets(k%).x AND posY% = pellets(k%).y THEN
IF pellets(k%).state = 1 THEN
pellets(k%).state = 0
PelletCounter = PelletCounter + 1
IF PelletCounter = MaxPellets THEN YouWin
END IF
  END IF
  NEXT
  inc = 1
END IF
'**DOWN**
CASE CHR$(0) + "P"
IF Map%(posX%, posY% + 1) = 9 THEN
  GOSUB Tileload
  posY% = posY% + 1
  FOR k% = 0 TO MaxPellets
  IF posX% = pellets(k%).x AND posY% = pellets(k%).y THEN
IF pellets(k%).state = 1 THEN
pellets(k%).state = 0
PelletCounter = PelletCounter + 1
IF PelletCounter = MaxPellets THEN YouWin
END IF
  END IF
  NEXT
  inc = 1
END IF
'**UP**
CASE CHR$(0) + "H"
IF Map%(posX%, posY% - 1) = 9 THEN
  GOSUB Tileload
  posY% = posY% - 1
  FOR k% = 0 TO MaxPellets
  IF posX% = pellets(k%).x AND posY% = pellets(k%).y THEN
IF pellets(k%).state = 1 THEN
pellets(k%).state = 0
PelletCounter = PelletCounter + 1
IF PelletCounter = MaxPellets THEN YouWin
END IF
  END IF
  NEXT
  inc = 1
END IF
'**ESCAPE KEY**
CASE CHR$(27)
Quit = 1
END
END SELECT
IF inc = 1 THEN
'***************DRAW PLAYER***************
x = posX% * 20
y = posY% * 20
SpriteS char(), x, y, 1
END IF

FOR m% = 1 TO MaxEnemies
Enemylogic m%
NEXT

'IF inc = 1 THEN
'*********************DRAW ENEMY****************************
FOR m% = 1 TO MaxEnemies
xe = Enemies(m%).x * 20
ye = Enemies(m%).y * 20
SpriteS enemy(), xe, ye, 1
'inc = 0
NEXT
'END IF

FOR m% = 1 TO MaxEnemies
IF posX% = Enemies(m%).x AND posY% = Enemies(m%).y THEN
CLS
SLEEP 1
CALL YouLose
SLEEP 1
Quit = 1
END
END IF
NEXT

FOR l = 0 TO 3
IF Map%(l, 0) = 0 THEN
  SpriteS brick0%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 1 THEN
  SpriteS brick1%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 2 THEN
  SpriteS brick2%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 3 THEN
  SpriteS brick3%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 4 THEN
  SpriteS brick4%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 5 THEN
  SpriteS brick5%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 6 THEN
  SpriteS brick6%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 7 THEN
  SpriteS brick7%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 8 THEN
  SpriteS brick8%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 9 THEN
  SpriteS background%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 10 THEN
  SpriteS brick10%(), l * 20, 0, 1
ELSEIF Map%(l, 0) = 11 THEN
  SpriteS brick11%(), l * 20, 0, 1
END IF
NEXT

nPrint 1, 1, "Score:" + STR$(PelletCounter), 1
nPrint 1, 10, "Time:" + STR$(INT(TIMER - time#)), 1

PUT (0, 0), buffer, PSET

LOOP UNTIL Quit = 1
SCREEN 0: WIDTH 80
Tileload:
x = posX%
y = posY%
IF Map%(x, y) = 0 THEN
  SpriteS brick0%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 1 THEN
  SpriteS brick1%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 2 THEN
  SpriteS brick2%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 3 THEN
  SpriteS brick3%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 4 THEN
  SpriteS brick4%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 5 THEN
  SpriteS brick5%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 6 THEN
  SpriteS brick6%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 7 THEN
  SpriteS brick7%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 8 THEN
  SpriteS brick8%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 9 THEN
  SpriteS background%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 10 THEN
  SpriteS brick10%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 11 THEN
  SpriteS brick11%(), x * 20, y * 20, 1
END IF

RETURN

SCREEN 0: WIDTH 80
tileload2:
x = Enemies(enemyNum).x
y = Enemies(enemyNum).y
IF Map%(x, y) = 0 THEN
  SpriteS brick0%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 1 THEN
  SpriteS brick1%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 2 THEN
  SpriteS brick2%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 3 THEN
  SpriteS brick3%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 4 THEN
  SpriteS brick4%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 5 THEN
  SpriteS brick5%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 6 THEN
  SpriteS brick6%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 7 THEN
  SpriteS brick7%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 8 THEN
  SpriteS brick8%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 9 THEN
  SpriteS background%(), x * 20, y * 20, 1
  FOR k% = 0 TO MaxPellets
IF pellets(k%).x = x AND pellets(k%).y = y THEN
 IF pellets(k%).state = 1 THEN Pixel x * 20 + 9, y * 20 + 9, 15
END IF
  NEXT
ELSEIF Map%(x, y) = 10 THEN
  SpriteS brick10%(), x * 20, y * 20, 1
ELSEIF Map%(x, y) = 11 THEN
  SpriteS brick11%(), x * 20, y * 20, 1
END IF

RETURN

END SUB

DEFSNG A-Z
SUB nPrint (xx%, yy%, Text$, col%)
x% = xx%
y% = yy%
  FOR i% = 0 TO LEN(Text$) - 1
x% = x% + 8
Offset% = 8 * ASC(MID$(Text$, i% + 1, 1)) + 14
FOR J% = 0 TO 7
 DEF SEG = &HFFA6
 Bit% = PEEK(Offset% + J%)
 IF Bit% AND 1 THEN Pixel x%, y% + J%, col%
 IF Bit% AND 2 THEN Pixel x% - 1, y% + J%, col%
 IF Bit% AND 4 THEN Pixel x% - 2, y% + J%, col%
 IF Bit% AND 8 THEN Pixel x% - 3, y% + J%, col%
 IF Bit% AND 16 THEN Pixel x% - 4, y% + J%, col%
 IF Bit% AND 32 THEN Pixel x% - 5, y% + J%, col%
 IF Bit% AND 64 THEN Pixel x% - 6, y% + J%, col%
 IF Bit% AND 128 THEN Pixel x% - 7, y% + J%, col%
NEXT J%
  NEXT i%
DEF SEG
END SUB

SUB Pixel (xx%, yy%, cc%)

DEF SEG = VARSEG(buffer(0))
POKE xx% + lutsegy(yy%), cc%

END SUB


REM $DYNAMIC
DEFINT A-Z
SUB SpriteS (Sprite(), xx, yy, frame)
DIM segADD AS LONG
TILEwidth = Sprite(0) \ 8
TILEheight = Sprite(1)
TP = TILEwidth * TILEheight
TH = TILEheight - 1
TW = TILEwidth - 1
TF = frame - 1

IF TP AND &H1 THEN
ToffsBYT = ((4 * frame) + TF) + (TP * TF)
ELSE
ToffsBYT = (4 * frame) + (TP * TF)
END IF

xLEFT = xx
xRIGHT = xx + TW
yTOP = yy
yBOTTOM = yy + TH

IF xLEFT < 0 THEN
sum = 0 - xLEFT
  IF sum < 0 THEN sum = -sum
  IF sum > TW THEN EXIT SUB
xLEFT = 0
CLIPoffsL = sum
CLIPadd = sum
END IF

IF xRIGHT > 319 THEN
sum = xRIGHT - 319
  IF sum > TW THEN EXIT SUB
xRIGHT = 319
CLIPadd = sum
END IF

IF yTOP < 0 THEN
sum = 0 - yTOP
  IF sum < 0 THEN sum = -sum
  IF sum > TH THEN EXIT SUB
yTOP = 0
CLIPoffsT = sum * TILEwidth
END IF

IF yBOTTOM > 199 THEN
sum = yBOTTOM - 199
  IF sum > TH THEN EXIT SUB
yBOTTOM = 199
END IF

t = ToffsBYT + CLIPoffsL + CLIPoffsT

segADD = lutsegy(yTOP)
DEF SEG = VARSEG(buffer(0))

FOR y = yTOP TO yBOTTOM
 FOR x = xLEFT TO xRIGHT
  DEF SEG = VARSEG(Sprite(0))
  c = PEEK(t)
  DEF SEG = VARSEG(buffer(0))
  POKE segADD + x, c
  t = t + 1
 NEXT
 t = t + CLIPadd
 segADD = segADD + 320
NEXT

END SUB

DEFSNG A-Z
SUB YouLose
SCREEN 12
COLOR 15
PRINT
PRINT
PRINT
PRINT
PRINT "            .::         .::   .::::::::.     .::     .::"
PRINT "             .::      .::   .::        .::   .::     .::             "
PRINT "               .:: .::      .::        .::   .::     .::"
PRINT "                 .::        .::        .::   .::     .::"
PRINT "                 .::        .::        .::   .::     .::"
PRINT "                 .::          .::     .::    .::     .::"
PRINT "                 .::            .::::          .::::: "
PRINT "                        "
PRINT "             .::            .::::::.      .:: ::     .::::::::"
PRINT "             .::         .::      .::    .::   .::   .::    "
PRINT "             .::        .::        .::   .::         .::    "
PRINT "             .::        .::        .::     .::       .::::::"
PRINT "             .::        .::        .::        .::    .::    "
PRINT "             .::          .::     .::   .::    .::   .::    "
PRINT "             .::::::::      .::::         .:: ::     .::::::::"
PRINT
PRINT
PRINT
COLOR 2
PRINT "SCORE:"; PelletCounter
PRINT "TIME:"; INT(TIMER - time#); "seconds"
END SUB

SUB YouWin
SCREEN 12
CLS
SLEEP 1
PRINT "You win"
PRINT
PRINT
COLOR 2
PRINT "SCORE:"; PelletCounter
PRINT "TIME:"; INT(TIMER - time#); "seconds"
PRINT
CALL anykey
END
END SUB


Title: New Challenge for hardcore QBers
Post by: oracle on May 26, 2003, 01:29:32 AM
If you guys optimised that code then you could make it even better... seph, you could eliminate the flicker with a WAIT &H3DA, 8 line somewhere.

Ninkazu: It's a start though. I've had a go at it, and the thing that annoyed me was that the ghosts didn't move very far from the centre. But at least he doesn't walk through the walls :wink:


Title: New Challenge for hardcore QBers
Post by: Ninkazu on May 26, 2003, 01:32:08 AM
Hey, he didn't want it to look professional, because his teacher wouldn't have believed he did it, so I just did what he asked me to do. If you check out the enemylogic sub, you'll see their movement is completely random and has nothing to do with your position.


Title: New Challenge for hardcore QBers
Post by: oracle on May 26, 2003, 01:35:39 AM
Well, the best way to deflect teacher suspiscions, I've found, is to do at least some of the code in class where they can see it being made. The first game I made, Creatures, I coded in class for some of the time so the teachers gave me 94% for it... I might put it on QBNZ but it's a bit crap compared with the likes of ZeroG...


Title: New Challenge for hardcore QBers
Post by: QB_GEEK on June 01, 2003, 03:29:22 AM
Coool progs for very little code, apart for the long one LOL....

 :lol:

QB_GEEK


Title: New Challenge for hardcore QBers
Post by: pr0gger on June 01, 2003, 04:34:51 PM
So if you lose, it fills the screen like so:

YOU LOSE

, but if you win:


You win.

Does anyone else see the irony in this  :lol: ;)


Title: New Challenge for hardcore QBers
Post by: na_th_an on June 01, 2003, 06:53:56 PM
64 lines classic pong (with original pong aesthetics):

(I cheated, of course. Made extensive use of ':', but aw, it is fun)

Use
LEFT SHIFT/LEFT CTRL to move left paddle and
RIGHT SHIFT/RIGHT ALT (Alt Gr) to move the right paddle.

Code:
'$DYNAMIC
DIM SHARED numeros%(9, 4, 2)
TYPE PelotaTipo
   x AS INTEGER
   y AS INTEGER
   vx AS INTEGER
   vy AS INTEGER
END TYPE
TYPE RaquetaTipo
   y AS INTEGER
   puntos AS INTEGER
END TYPE
DIM pelota AS PelotaTipo, Raqueta1 AS RaquetaTipo, Raqueta2 AS RaquetaTipo
RESTORE numeros: FOR i% = 0 TO 9: FOR j% = 0 TO 4: FOR k% = 0 TO 2: READ numeros%(i%, j%, k%): NEXT k%, j%, i%
PRINT "Just PONG! by NATHAN @ WOPR": PRINT "Left paddle: left_shift/ctrl, Right paddle: right_shift/alt": PRINT "Press any key to serve. enjoy!": SLEEP: k$ = INKEY$: SCREEN 7, , 1, 0
pelota.x = 15400: pelota.y = 9200: Raqueta1.y = 8000: Raqueta1.puntos = 0: Raqueta2.y = 8000: Raqueta2.puntos = 0: terminado% = 0: acabado% = 0: Incr% = 200: DEF SEG = 0
WHILE NOT terminado%
   PintaPantalla Raqueta1, Raqueta2, pelota: PCOPY 1, 0
   WHILE INKEY$ = "": WEND: acabado% = 0: k% = INT(RND * 2) - 1
   IF k% THEN pelota.vx = -200 ELSE pelota.vx = 200
   pelota.vy = INT(RND * 201) - 100: pelota.x = 15400: pelota.y = 9200
   IF Raqueta1.puntos = 100 OR Raqueta2.puntos = 100 THEN Raqueta1.puntos = 0: Raqueta2.puntos = 0
   WHILE NOT acabado%
      k$ = INKEY$: pelota.x = pelota.x + pelota.vx: pelota.y = pelota.y + pelota.vy: Incr% = ABS(pelota.vx \ 100) * 100
      IF (PEEK(1047) AND 2) AND Raqueta1.y > 800 THEN Raqueta1.y = Raqueta1.y - Incr%
      IF (PEEK(1047) AND 4) AND Raqueta1.y < 15200 THEN Raqueta1.y = Raqueta1.y + Incr%
      IF (PEEK(1047) AND 1) AND Raqueta2.y > 800 THEN Raqueta2.y = Raqueta2.y - Incr%
      IF (PEEK(1047) AND 8) AND Raqueta2.y < 15200 THEN Raqueta2.y = Raqueta2.y + Incr%
      IF INP(&H60) = 1 THEN acabado% = -1: terminado% = -1
      IF pelota.x <= 800 AND pelota.y - Raqueta1.y < 4000 AND pelota.y - Raqueta1.y > -700 THEN pelota.vx = -pelota.vx - SGN(pelota.vx) * 8: d% = Raqueta1.y + 2000 - pelota.y: pelota.vy = pelota.vy - Signo%(pelota.vy) * d% \ 10
      IF pelota.x >= 30400 AND pelota.y - Raqueta2.y < 4000 AND pelota.y - Raqueta2.y > -700 THEN pelota.vx = -pelota.vx - SGN(pelota.vx) * 8: d% = Raqueta2.y + 2000 - pelota.y: pelota.vy = pelota.vy - Signo%(pelota.vy) * d% \ 10
      IF pelota.y >= 18400 OR pelota.y <= 800 THEN pelota.vy = -pelota.vy
      IF pelota.x <= 0 THEN acabado% = -1: Raqueta2.puntos = Raqueta2.puntos + 1
      IF pelota.x >= 31200 THEN acabado% = -1: Raqueta1.puntos = Raqueta1.puntos + 1
      PintaPantalla Raqueta1, Raqueta2, pelota
      WAIT &H3DA, 8: WAIT &H3DA, 8, 8: PCOPY 1, 0
   WEND
WEND
SCREEN 0: WIDTH 80: PRINT "(C) NATHAN @ WOPR, email: na_th_an@hotmail.com"
numeros:
DATA 1,1,1,1,0,1,1,0,1,1,0,1,1,1,1,0,1,0,0,1,0,0,1,0,0,1,0,0,1,0,1,1,1,0,0,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,0,0,1,1,1,1,1,0,1,1,0,1,1,1,1,0,0,1,0,0,1,1,1,1,1,0,0,1,1,1,0,0,1,1,1,1,1,1,1,1,0,0,1,1,1,1,0,1,1,1,1,1,1,1,0,0,1,0,0,1
DATA 0,0,1,0,0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,1,1,1,1,0,0,1,0,0,1

SUB PintaNumero (x%, y%, punto$)
   FOR i% = 1 TO LEN(punto$): m% = ASC(MID$(punto$, i%, 1)) - ASC("0"): FOR j% = 0 TO 4: FOR k% = 0 TO 2
   IF numeros%(m%, j%, k%) = 1 THEN LINE (x% * 8 + k% * 8, y% * 8 + j% * 8)-(7 + x% * 8 + k% * 8, 7 + y% * 8 + j% * 8), 15, BF
   NEXT k%: NEXT j%: x% = x% + 4: NEXT i%
END SUB

SUB PintaPantalla (Raqueta1 AS RaquetaTipo, Raqueta2 AS RaquetaTipo, pelota AS PelotaTipo)
   LINE (0, 0)-(319, 199), 0, BF: LINE (0, 0)-(319, 7), 15, BF: LINE (0, 192)-(319, 199), 15, BF: FOR i% = 8 TO 192 STEP 16: LINE (156, i%)-(164, i% + 8), 15, BF: NEXT i%
   px% = pelota.x \ 100: py% = pelota.y \ 100: LINE (px%, py%)-(7 + px%, 7 + py%), 15, BF: ry% = Raqueta1.y \ 100: LINE (0, ry%)-(7, ry% + 39), 15, BF: ry% = Raqueta2.y \ 100: LINE (312, ry%)-(319, ry% + 39), 15, BF
   punto$ = LTRIM$(STR$(Raqueta1.puntos)): IF LEN(punto$) = 1 THEN punto$ = "0" + punto$
   PintaNumero 5, 2, punto$
   punto$ = LTRIM$(STR$(Raqueta2.puntos)): IF LEN(punto$) = 1 THEN punto$ = "0" + punto$
   PintaNumero 29, 2, punto$
END SUB

FUNCTION Signo% (a%)
   IF a% < 0 THEN Signo% = -1 ELSE Signo% = 1
END FUNCTION

' and...
' LINE 64 LOL


Enjoy!

PS: That's what I call "horizontal programming" LOL


Title: New Challenge for hardcore QBers
Post by: oracle on June 01, 2003, 09:05:38 PM
:o

Where can I find the "origional pong" if it exists???

ps: na_th: that goes in the limited line category at QBNZ. That's awesome for 64 lines!!!


Title: New Challenge for hardcore QBers
Post by: toonski84 on June 01, 2003, 10:45:14 PM
the original pong (discounting the 1959 one made on an osiolliscope (sp)) is an arcade game made in the 70s.  I dont think its circuits are even digital, because it can't be emulated.


Title: New Challenge for hardcore QBers
Post by: oracle on June 01, 2003, 11:01:54 PM
Oh well...

Anyone make a spacies clone?


Title: New Challenge for hardcore QBers
Post by: na_th_an on June 02, 2003, 07:12:40 AM
Pong was "hard coded" in analogic board circuits (no microprocessor). You can find the Atari 2600 version, though, as the most ancient (1977).