So as my last few challenges have met limited to no interest,i got to thiking, and inspired by a hack a day project i saw i came up with a challenge i think should appeal to many, and hopefully we will see some really cool games come out of it.
So, my challenge, should you choose to accept...is....
Make a game using only this LED style matrix as your display. Any type of game is fine, i am going for a simple jumping side scroller, If you want to use a matrix that has a differant layout or resolution(mine is 40*20 !!! LOL) then please feel free...
Here is the code for the matrix.....thanks folks..UNSEEN
I thought that i might inspire some poeple with my challenge, but it seems not to have had quite the impact i was expecting and hoping for ( maybe i need to be more patient?). Nether the less, i have continued with my project and have now completed 4 levels.
Simple levels can be made by creating new data blocks, bridges and elevators however are more difficult to code.
I am going to leave this project alone now and start work on a level creator, which will write the full code for level's and the main programme. This could take sometime to get things like multiple bridges and enemies sorted but one stage at a time. Expect to see v.01 sometime this week....
You play a blue jumping blob...
Though it has a few nigling little problems, the levels are fully playable, get to the red X to go to the next level.
Arrow keys control movement (Up = Jump - left/right move and enter skips levels!!), it is far from finished so please let me know how you think i can improve it or any ideas for what you would like in the game.
On the last level, sometimes when jumping on the bridge, you fall through it!!!! I am trying to figure out how to fix this, but if anyone has any ideas please let me know as this is something i am having great trouble with. ..thanks folks...UNSEEN
updated CODE >>>>>>>>>>>>>>>>>>>>>>>>>>
'Qb jump version .01 - By Unseen Machine
DECLARE SUB level3 ()
DECLARE SUB level2 ()
DECLARE SUB loose ()
DECLARE SUB loadplayer ()
DECLARE SUB startgame ()
DIM SHARED level AS INTEGER
DIM SHARED bstart1 AS INTEGER, bstart2 AS INTEGER
DIM SHARED bcnt AS INTEGER, grav AS SINGLE
DIM SHARED px AS INTEGER, py AS INTEGER, bflag AS INTEGER
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,9,9,4,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,4,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,4,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,9,9,4,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,2,2,2,2,2,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,2,2,9,9,9,6,6,6,6,6,6,6,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,9,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,2,2,9,9,2,9,9,2,9,9,9,2,2,6,9,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,6,6,9,9,6,9,9,6,9,9,9,6,6,6,9,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,2,2,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,2,2,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,6,9,9,2,2,9,9,9,9,9,9,9
DATA 9,9,9,6,6,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,2,2,9,9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,9
DATA 2,2,2,2,2,2,2,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,2,2,2,2,6,6,9,9,9,9,9,9,9
DATA 6,6,6,6,6,6,6,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,6,6,6,6,6,6,6,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,4,9,9,9,4,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,4,9,4,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,4,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,4,9,4,9,9,9,2,2,9,9,9,9,9,9,9,9,9,9,9,7,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,4,9,9,9,4,9,2,6,6,2,9,9,2,9,9,2,9,9,2,2,2,2,9,9,9,9,9,9,9,9,9,2,2,9,9,9,9,9,9
DATA 2,9,9,9,9,9,9,6,9,6,6,9,9,6,9,9,6,9,9,6,6,6,6,9,9,9,9,9,9,9,9,2,6,6,2,9,9,9,9,9
DATA 6,2,2,2,2,2,2,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,6,6,2,9,9,9,9
DATA 9,6,6,6,6,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,6,9,9,6,6,2,9,9,9
DATA 9,6,6,6,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,6,6,9,9,9,6,6,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,6,6,6,6,9,9,9,9,6,2,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,6,6,6,9,9,9,9,9,9,9,6,6,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,9,9,9,2,2,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,2,9,9,9,9,9,9,9,2,2,9,9,9,6,9,9,2,6,2,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,2
DATA 9,9,9,9,6,2,9,9,9,9,9,9,6,6,2,9,9,6,9,9,9,6,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,6
DATA 9,9,9,9,6,6,9,9,9,2,9,2,6,6,6,9,9,6,9,9,9,6,9,9,9,6,6,9,9,9,9,9,9,9,9,2,2,9,9,6
DATA 9,9,9,9,6,6,9,9,9,6,2,6,6,6,6,9,9,6,9,9,9,6,9,9,9,6,6,9,7,9,2,9,9,9,2,6,6,2,9,6
DATA 2,2,2,2,6,6,9,9,9,6,6,6,6,6,6,9,9,6,9,9,9,6,9,9,9,6,6,2,2,2,6,9,9,2,6,6,6,6,2,6
DATA 6,6,6,6,6,6,6,9,9,6,6,6,6,6,6,9,9,6,9,9,9,6,9,9,9,6,6,6,6,6,6,9,9,6,6,6,6,6,6,6
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,4,9,9,9,4,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,4,9,4,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,4,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,4,9,4,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,2,9,9,9,9,9,9,9,9,9,9
DATA 9,4,9,9,9,4,9,9,9,9,9,9,9,9,9,2,9,9,9,9,9,9,9,9,9,9,9,6,6,6,2,9,9,9,9,9,9,9,9,9
DATA 2,2,2,2,2,2,2,2,9,9,9,9,9,9,9,6,9,2,9,9,9,9,2,9,9,9,9,9,9,6,6,9,9,2,9,9,9,9,9,9
DATA 6,6,6,6,6,6,6,6,2,9,9,9,9,9,9,9,9,6,9,2,9,9,6,9,9,9,9,9,9,9,9,9,2,6,2,9,9,9,9,9
DATA 9,9,9,9,9,9,9,6,6,2,9,9,9,9,9,9,9,9,9,6,9,9,9,9,9,2,9,9,9,9,9,9,6,6,6,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,6,6,2,9,2,2,9,9,9,9,9,9,9,9,9,9,9,6,9,9,9,9,9,9,9,9,9,9,9,9,2,2
DATA 9,9,9,9,9,9,9,9,9,6,6,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,9,9,9,6
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,2,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2
DATA 9,9,9,9,2,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,9,9,9,9,9,9,9,2,6,6
DATA 9,9,9,9,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,9,9,9,9,9,9,2,6,6,6
DATA 9,9,2,2,6,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,2,2,9,9,2,2,6,6,6,6
DATA 2,2,6,6,6,6,2,9,2,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,6,6,9,9,6,6,6,6,6,6
DATA 6,6,6,6,6,6,6,9,6,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,6,6,9,9,6,6,6,6,6,6
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,4,9,9,9,4,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,4,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,4,9,4,9,9
DATA 9,9,7,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,4,9,9,9,4,9
DATA 9,2,2,9,9,9,9,9,9,9,9,9,9,2,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,2,9,9,2,2,2,2,2,2,2,9
DATA 9,6,6,2,9,9,9,9,9,9,2,9,9,6,2,9,9,9,9,9,8,8,9,9,9,9,2,9,9,6,9,9,6,6,6,6,6,6,6,9
DATA 9,9,6,6,9,9,9,9,9,9,6,9,9,6,6,9,9,9,9,9,8,8,9,9,9,9,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,2,2,2,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,6,6,6,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,2,9,8,8,9,9,9,9,9,9,9,9,9,9,9,7,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,6,6,9,8,8,9,9,9,9,9,9,9,9,9,9,2,2,2,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,9,9,8,8,9,9,9,9,9,9,9,9,9,9,6,6,6,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,2,9,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,2,9,9,9,9,8,8,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,9,9,9,9,9,9,9,9,9,9,9,9,6,6,9,9,9,9,8,8,9,9,9,9,2,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,2,9,2,2,2,2,2,2,9,9,9,9,9,6,6,9,9,9,9,8,8,9,9,9,9,6,9,9,9,9,9,9,9,9,9,9,9,9,9
DATA 9,9,2,6,6,6,6,6,6,2,2,2,2,2,6,6,9,9,9,2,8,8,9,9,9,9,6,9,9,2,2,2,9,9,9,9,9,9,9,9
DATA 9,2,6,6,6,6,6,6,6,6,6,6,6,6,6,6,9,9,9,6,8,8,9,9,9,9,6,9,9,6,6,6,9,9,9,9,9,9,9,9
SUB level2
'bridge one animation
IF bcnt <= 13 THEN
CIRCLE (bstart1, 350), 7, 9
ELSEIF bcnt > 13 THEN
CIRCLE (bstart1 + 15, 350), 7, 9
END IF
PAINT STEP(0, 0), 0, 9
FOR i = 1 TO 4 STEP 1
CIRCLE STEP(15, 0), 7, 9
PAINT STEP(0, 0), 0, 9
NEXT
IF bcnt <= 13 THEN
CIRCLE (bstart1 + 15, 350), 7, 14
ELSEIF bcnt > 13 THEN
CIRCLE (bstart1, 350), 7, 14
END IF
PAINT STEP(0, 0), 14, 14
FOR i = 1 TO 4 STEP 1
CIRCLE STEP(15, 0), 7, 14
PAINT STEP(0, 0), 14, 14
NEXT
END SUB
SUB level3
'bridge two animation
IF bcnt <= 12 THEN
CIRCLE (355, bstart2), 7, 9
ELSE
CIRCLE (355, bstart2 - 15), 7, 9
END IF
PAINT STEP(0, 0), 0, 9
FOR i = 1 TO 2 STEP 1
CIRCLE STEP(15, 0), 7, 9
PAINT STEP(0, 0), 0, 9
NEXT
IF bcnt <= 12 THEN
CIRCLE (355, bstart2 - 15), 7, 14
ELSE
CIRCLE (355, bstart2), 7, 14
END IF
PAINT STEP(0, 0), 14, 14
FOR i = 1 TO 2 STEP 1
CIRCLE STEP(15, 0), 7, 14
PAINT STEP(0, 0), 14, 14
NEXT
END SUB
SUB loadplayer
px = 40: py = 305
GOSUB drawplyr
now! = TIMER
now2! = TIMER
DO
'collisions and empty space(gravity)
newnow! = TIMER
IF POINT(px, py + 45) = 0 AND newnow! - now! >= grav AND py < 330 THEN
GOSUB clrplyr
py = py + 15
GOSUB drawplyr
grav = grav / 1.12 'acceleration factor
now! = TIMER
ELSEIF POINT(px, py + 45) > 0 THEN
grav = .08
END IF
'bottom of screen
IF py >= 330 THEN CALL loose
'red x win collison
IF POINT(px + 15, py) = 4 OR POINT(px + 15, py + 15) = 4 OR POINT(px + 15, py + 30) = 4 THEN EXIT DO
IF POINT(px - 15, py) = 4 OR POINT(px - 15, py + 15) = 4 OR POINT(px - 15, py + 30) = 4 THEN EXIT DO
I am currently working on the v.01 QB64 version of the level creator, which (when the levels are loaded in to the game player - not yet coded) uses the same movement and design but is in scrolling worlds form rather than static levels. It will be a while before i release that yet as i want it to be fully functional.
It took 4 days of hard head scratching and several other programmes to convert stuff for me to get this far. I think that i have ironed out most bugs that i can find, if anyone finds any please report them. If anyone has any idea for the programme (not to hard though please) or any tips on how to improve it please let me know.
I am begining to feel as if i am the only person who does QBasic anymore...come on folks!!!
- Note to qb64 users - i have noticed a problem when trying to paint whilst holding down the mouse. It seem to reposition itself for some reason.
Basic Edition v.01 features...
- Generate maps(10 levels max)
- Transporters(1 pair per level - 1 way transport)
- Player Start/Exit posistioning
- Autosave level on new level
- Automatic code generator - No Need to write any code at all!!!!
- Multiple map sets (custom save names)
- Basic error checking
to be added in v.02
- Bridge's (1 per level) (custom size and movement(distance NOT direction)
- Show entire matrix / only show solids option
- Duck Down control
- Variable Gravity
- Empty level check
- Other bug fixes
- Improved error checking
- Level delete (with option to re-organise array)
- Load map set
WARNING!!! When saving files are saved to C:\ as .bas, so be careful!!
NOTE - I have updated this code to version .01.1 0 which has some pretty serious bug fixes and improved useabilty (exit points can now be moved without clearing the whole level!)
DECLARE SUB buildgame ()
DECLARE SUB loadlevel ()
DECLARE SUB savelevel ()
DECLARE SUB clrgrid ()
DECLARE SUB draweditor ()
'variables that are going to be written into the code
DIM SHARED t1x(1 TO 10) AS INTEGER, t2x(1 TO 10) AS INTEGER
DIM SHARED t1y(1 TO 10) AS INTEGER, t2y(1 TO 10) AS INTEGER
DIM SHARED map(1 TO 10, 800) AS INTEGER
DIM SHARED gpx(1 TO 10) AS INTEGER, gpy(1 TO 10) AS INTEGER
DIM mxmin AS INTEGER, mxmax AS INTEGER, mymin AS INTEGER, mymax AS INTEGER
DIM rowcnt AS INTEGER, colcnt AS INTEGER, clr AS INTEGER
DIM clrymin AS INTEGER, itmcnt AS INTEGER, item AS STRING
DIM SHARED tranflag1(1 TO 10) AS INTEGER, tranflag2(1 TO 10) AS INTEGER
DIM SHARED px(1 TO 10) AS INTEGER, py(1 TO 10) AS INTEGER
DIM SHARED level AS INTEGER, plyrflag(1 TO 10) AS INTEGER
DIM SHARED exitflag(1 TO 10) AS INTEGER
DIM SHARED levelmax AS INTEGER
DIM SHARED xitx(1 TO 10) AS INTEGER, xity(1 TO 10) AS INTEGER
CLS
SCREEN 12
CALL draweditor
level = 1
CALL loadlevel
DIM SHARED m(8) AS LONG, mb AS INTEGER, mx AS INTEGER, my AS INTEGER
m(0) = &H8BE58955
m(1) = &H78B0C5E
m(2) = &HD88933CD
m(3) = &H890A5E8B
m(4) = &H85E8B07
m(5) = &H5E8B0F89
m(6) = &H5D178906
m(7) = &H8CA
DEF SEG = VARSEG(m(0))
IF POINT(mxmin + 5, mymin + 5) <> 1 AND POINT(mxmin + 5, mymin + 5) <> 15 AND POINT(mxmin + 5, mymin + 5) <> 4 THEN
PAINT (mxmin + 5, mymin + 5), clr, 7
END IF
END IF
CALL ABSOLUTE(1, mb, mx, my, VARPTR(m(0)))
END IF
END IF
kb$ = INKEY$
SELECT CASE kb$
CASE CHR$(27)
SYSTEM
END SELECT
LOOP
SYSTEM
SUB buildgame
DIM cnt AS INTEGER, lvlcnt AS INTEGER
'check each level for player start - exit and transporters
CALL savelevel
DO
lvlcnt = lvlcnt + 1
IF tranflag1(lvlcnt) = 1 AND tranflag2(lvlcnt) = 0 THEN
msg$ = "Error on level " + STR$(lvlcnt) + " - No second transporter point."
GOSUB builderror
END IF
IF px(lvlcnt) <= 0 OR plyrflag(level) = 0 THEN
msg$ = "Error on level " + STR$(lvlcnt) + " - No player start point."
GOSUB builderror
END IF
IF exitflag(lvlcnt) <= 0 THEN
msg$ = "Error on level " + STR$(lvlcnt) + " - No exit point."
GOSUB builderror
END IF
LOOP UNTIL lvlcnt = levelmax
lvlcnt = 0
DO
LOCATE 25, 1: PRINT SPACE$(60)
LOCATE 25, 1: INPUT "Enter a name for your game : ", gname$
LOOP UNTIL LEN(gname$) > 0
CLOSE
OPEN "c:\" + gname$ + ".bas" FOR OUTPUT AS #1
PRINT #1, "DECLARE SUB loose ()"
PRINT #1, "DECLARE SUB loadplayer ()"
PRINT #1, "DECLARE SUB startgame ()"
PRINT #1, ""
PRINT #1, "DIM SHARED level AS INTEGER"
PRINT #1, "DIM SHARED grav AS SINGLE"
PRINT #1, "DIM SHARED px(1 to 10) AS INTEGER, py(1 to 10) AS INTEGER"
PRINT #1, "dim shared t1x(1 to 10) as integer,t1y(1 to 10) as integer"
PRINT #1, "dim shared t2x(1 to 10) as integer,t2y(1 to 10) as integer"
Well, after taking a short break I resumed work on my Super Low Res Platform game maker.
Version .01.4 updates...
- All Game objects are now re-posistionable.
- Simple bridge implementation - (1 bridge per level - changeable direction and distance(bridge will destroy any background or game object it touches at the moment!! Be carefull!!))
to come in the next update...
- Load levels from a game all ready made for edit.
- Multiple level view. (Click to load into editor).
- and possibly lava eruptions!!!
DECLARE SUB bumparray ()
DECLARE SUB buildgame ()
DECLARE SUB loadlevel ()
DECLARE SUB savelevel ()
DECLARE SUB clrgrid ()
DECLARE SUB draweditor ()
'variables that are going to be written into the code
DIM SHARED t1x(1 TO 10) AS INTEGER, t2x(1 TO 10) AS INTEGER
DIM SHARED t1y(1 TO 10) AS INTEGER, t2y(1 TO 10) AS INTEGER
DIM SHARED map(1 TO 10, 800) AS INTEGER
DIM SHARED gpx(1 TO 10) AS INTEGER, gpy(1 TO 10) AS INTEGER
'bridge variables
DIM SHARED bflag(1 TO 10) AS INTEGER
DIM SHARED gbx1(1 TO 10) AS INTEGER, gby1(1 TO 10) AS INTEGER
DIM SHARED bx1(1 TO 10) AS INTEGER, by1(1 TO 10) AS INTEGER
DIM SHARED bcnt(1 TO 10) AS INTEGER, bdirect(1 TO 10) AS INTEGER 'movement & direction
'Player - level and exit variables
DIM SHARED px(1 TO 10) AS INTEGER, py(1 TO 10) AS INTEGER
DIM SHARED level AS INTEGER, plyrflag(1 TO 10) AS INTEGER
DIM SHARED exitflag(1 TO 10) AS INTEGER, levelmax AS INTEGER
DIM SHARED xitx(1 TO 10) AS INTEGER, xity(1 TO 10) AS INTEGER
'transporter variables
DIM SHARED tranflag1(1 TO 10) AS INTEGER, tranflag2(1 TO 10) AS INTEGER
DIM SHARED gt1x(1 TO 10) AS INTEGER, gt2x(1 TO 10) AS INTEGER
DIM SHARED gt1y(1 TO 10) AS INTEGER, gt2y(1 TO 10) AS INTEGER
'editor variables
DIM mxmin AS INTEGER, mxmax AS INTEGER, mymin AS INTEGER, mymax AS INTEGER
DIM rowcnt AS INTEGER, colcnt AS INTEGER, clr AS INTEGER
DIM clrymin AS INTEGER, itmcnt AS INTEGER, item AS STRING
CLS
SCREEN 12
CALL draweditor
level = 1
CALL loadlevel
DIM SHARED m(8) AS LONG, mb AS INTEGER, mx AS INTEGER, my AS INTEGER
m(0) = &H8BE58955
m(1) = &H78B0C5E
m(2) = &HD88933CD
m(3) = &H890A5E8B
m(4) = &H85E8B07
m(5) = &H5E8B0F89
m(6) = &H5D178906
m(7) = &H8CA
DEF SEG = VARSEG(m(0))
Sorry about the last update, it was full of dodgy little bugs. So i have worked on it a bit, and have managed to iron out most of them.
I have started work on a loading option so levels from all ready made games can be edited. I am however having trouble figuring out the best way to get all the level variables back in, this means that only the parts of the level stored in the DATA blocks can be edited at the moment. You will have to replace bridges, start\exit points and transporters, but i will work on it.
Lava although placeable(only in the bottom row & only 3) does not yet function. Until i figure out to pass the varibles back properly in the loading, i am going to leave it out.
So this lovely update comes with the following improvements....
- Main menu ( Will be graphical in the future ) New Game \ Load Game \ Exit
- Load level backgrounds for edit
- Imporoved level deletion (no longer cause's errors)
- A few other little tweaks to improve performance
DECLARE SUB loadgame ()
DECLARE SUB mainmenu ()
DECLARE SUB bumparray ()
DECLARE SUB buildgame ()
DECLARE SUB loadlevel ()
DECLARE SUB savelevel ()
DECLARE SUB clrgrid ()
DECLARE SUB draweditor ()
'variables that are going to be written into the code
DIM SHARED t1x(1 TO 10) AS INTEGER, t2x(1 TO 10) AS INTEGER
DIM SHARED t1y(1 TO 10) AS INTEGER, t2y(1 TO 10) AS INTEGER
DIM SHARED map(1 TO 10, 800) AS INTEGER
DIM SHARED gpx(1 TO 10) AS INTEGER, gpy(1 TO 10) AS INTEGER
'bridge variables
DIM SHARED bflag(1 TO 10) AS INTEGER
DIM SHARED gbx1(1 TO 10) AS INTEGER, gby1(1 TO 10) AS INTEGER
DIM SHARED bx1(1 TO 10) AS INTEGER, by1(1 TO 10) AS INTEGER
DIM SHARED bcnt(1 TO 10) AS INTEGER, bdirect(1 TO 10) AS INTEGER 'movement & direction
'Player - level and exit variables
DIM SHARED px(1 TO 10) AS INTEGER, py(1 TO 10) AS INTEGER
DIM SHARED level AS INTEGER, plyrflag(1 TO 10) AS INTEGER
DIM SHARED exitflag(1 TO 10) AS INTEGER, levelmax AS INTEGER
DIM SHARED xitx(1 TO 10) AS INTEGER, xity(1 TO 10) AS INTEGER
'transporter variables
DIM SHARED tranflag1(1 TO 10) AS INTEGER, tranflag2(1 TO 10) AS INTEGER
DIM SHARED gt1x(1 TO 10) AS INTEGER, gt2x(1 TO 10) AS INTEGER
DIM SHARED gt1y(1 TO 10) AS INTEGER, gt2y(1 TO 10) AS INTEGER
'editor variables
DIM mxmin AS INTEGER, mxmax AS INTEGER, mymin AS INTEGER, mymax AS INTEGER
DIM rowcnt AS INTEGER, colcnt AS INTEGER, clr AS INTEGER
DIM clrymin AS INTEGER, itmcnt AS INTEGER, item AS STRING
'lava variables
DIM SHARED lx(1 TO 3, 1 TO 10) AS INTEGER, ly(1 TO 3, 1 TO 10) AS INTEGER
DIM SHARED lcnt(1 TO 3, 1 TO 10) AS INTEGER, lflag(1 TO 3, 1 TO 10) AS INTEGER
CLS
SCREEN 12
CALL mainmenu
CALL draweditor
level = 1
CALL loadlevel
DIM SHARED m(8) AS LONG, mb AS INTEGER, mx AS INTEGER, my AS INTEGER
m(0) = &H8BE58955
m(1) = &H78B0C5E
m(2) = &HD88933CD
m(3) = &H890A5E8B
m(4) = &H85E8B07
m(5) = &H5E8B0F89
m(6) = &H5D178906
m(7) = &H8CA
DEF SEG = VARSEG(m(0))
IF POINT(mxmin + 5, mymin + 5) <> 1 AND POINT(mxmin + 5, mymin + 5) <> 15 AND POINT(mxmin + 5, mymin + 5) <> 4 AND POINT(mxmin + 5, mymin + 5) <> 14 AND POINT(mxmin + 5, mymin + 5) <> 12 THEN
PAINT (mxmin + 5, mymin + 5), clr, 7
END IF
END IF
CALL ABSOLUTE(1, mb, mx, my, VARPTR(m(0)))
END IF
END IF
kb$ = INKEY$
SELECT CASE kb$
CASE CHR$(27)
SYSTEM
END SELECT
LOOP
SYSTEM
resetmouse:
DO
CALL ABSOLUTE(3, mb, mx, my, VARPTR(m(0)))
LOOP UNTIL mb = 0
RETURN
drawplyr:
PAINT (px(level), py(level)), 1, 7
FOR i = 1 TO 2 STEP 1
PAINT STEP(0, 10), 1, 7
NEXT
RETURN
clrbridge:
PAINT (gbx1(level), gby1(level)), 0, 7
FOR i = 1 TO 3 STEP 1
PAINT STEP(10, 0), 0, 7
NEXT
bflag(level) = 0
RETURN
drawbridge:
PAINT (gbx1(level), gby1(level)), 14, 7
FOR i = 1 TO 3 STEP 1
PAINT STEP(10, 0), 14, 7
NEXT
bflag(level) = 1
RETURN
SUB buildgame
DIM cnt AS INTEGER, lvlcnt AS INTEGER
'check each level for player start - exit and transporters
CALL savelevel
DO
lvlcnt = lvlcnt + 1
IF tranflag1(lvlcnt) = 1 AND tranflag2(lvlcnt) = 0 THEN
msg$ = "Error on level " + STR$(lvlcnt) + " - No second transporter point."
GOSUB builderror
END IF
IF px(lvlcnt) <= 0 OR plyrflag(level) = 0 THEN
msg$ = "Error on level " + STR$(lvlcnt) + " - No player start point."
GOSUB builderror
END IF
IF exitflag(lvlcnt) <= 0 THEN
msg$ = "Error on level " + STR$(lvlcnt) + " - No exit point."
GOSUB builderror
END IF
LOOP UNTIL lvlcnt = levelmax
lvlcnt = 0
DO
LOCATE 26, 1: PRINT SPACE$(60)
LOCATE 26, 1: INPUT "Enter a name for your game : ", gname$
LOOP UNTIL LEN(gname$) > 0
CLOSE
OPEN "c:\" + gname$ + ".bas" FOR OUTPUT AS #1
PRINT #1, "DECLARE SUB loose ()"
PRINT #1, "DECLARE SUB loadplayer ()"
PRINT #1, "DECLARE SUB startgame ()"
PRINT #1, ""
PRINT #1, "DIM SHARED level AS INTEGER"
PRINT #1, "DIM SHARED grav AS SINGLE"
PRINT #1, "DIM SHARED px(1 to 10) AS INTEGER, py(1 to 10) AS INTEGER"
PRINT #1, "dim shared t1x(1 to 10) as integer,t1y(1 to 10) as integer"
PRINT #1, "dim shared t2x(1 to 10) as integer,t2y(1 to 10) as integer"
PRINT #1, "dim shared bx1(1 to 10) as integer, by1(1 to 10) as integer"
PRINT #1, "dim shared bdirect(1 to 10) as integer, bcnt(1 to 10) as integer"
PRINT #1, "dim shared bflag(1 to 10) as integer,mcnt as integer"
PRINT #1, "DIM SHARED lx(1 TO 3, 1 TO 10) AS INTEGER, ly(1 TO 3, 1 TO 10) AS INTEGER"
PRINT #1, "DIM SHARED lcnt(1 TO 3, 1 TO 10) AS INTEGER, lflag(1 TO 3, 1 TO 10) AS INTEGER"
PRINT #1, ""
PRINT #1, "grav = .08"
PRINT #1, "OUT &H3C8, 12: OUT &H3C9, 63: OUT &H3C9, 8: OUT &H3C9, 7"
PRINT #1, ""
PRINT #1, "DO"
PRINT #1, " level = level + 1"
PRINT #1, " CALL startgame"
PRINT #1, " CALL loadplayer"
PRINT #1, " "
PRINT #1, " "
PRINT #1, ""
PRINT #1, "LOOP UNTIL level = "; levelmax
Based on breakout, this is a final tweaked version of .01. Let me know what you think, UNSEEN.
code....
'SLR Games - Brick Smash v.01 - By Unseen Machine
DIM SHARED scrn AS LONG, cx AS INTEGER, cy AS INTEGER, pflag AS INTEGER, bcnt AS INTEGER
DIM SHARED fnt AS LONG, px AS INTEGER, py AS INTEGER, oldpx AS INTEGER, oldpy AS INTEGER
DIM SHARED KeyDown(127) AS LONG, bx AS INTEGER, by AS INTEGER, bdirect AS INTEGER
DIM SHARED colcnt AS INTEGER, rowcnt AS INTEGER, brick(1 TO 7, 1 TO 5) AS INTEGER
DIM SHARED lives AS INTEGER
RANDOMIZE TIMER
_TITLE " Brick Smash v.01"
scrn = _NEWIMAGE(1200, 900, 12)
SCREEN scrn, , 1, 1
CALL drawgrid
CALL Drawbricks
px = 540: py = 610: pflag = 1
rndm = INT(RND * 5) + 1
bx = 560: by = 390
FOR c = 1 TO rndm
by = by - 20
NEXT
bdinitial = INT(RND * 2)
IF bdinitial = 1 THEN bdirect = 4 ELSE bdirect = 2
IF POINT(bx + 20, by + 20) = 15 AND bdirect = 2 THEN bdirect = 3
IF POINT(bx, by + 20) = 15 AND bdirect = 2 THEN bdirect = 3
IF POINT(bx - 20, by + 20) = 15 AND bdirect = 4 THEN bdirect = 1
IF POINT(bx, by + 20) = 15 AND bdirect = 2 THEN bdirect = 3
IF bdirect = 3 AND bx = 1080 THEN bdirect = 1
IF bdirect = 1 AND by = 50 THEN bdirect = 4
IF bdirect = 4 AND bx = 100 THEN bdirect = 2
IF bdirect = 1 AND bx = 100 THEN bdirect = 3
IF bdirect = 3 AND by = 50 THEN bdirect = 2
IF bdirect = 2 AND bx = 1080 THEN bdirect = 4
IF bdirect = 1 THEN 'up left
IF by > 50 THEN by = by - 20
IF bx > 100 THEN bx = bx - 20
ELSEIF bdirect = 2 THEN 'down right
IF by < 620 THEN by = by + 20
IF bx < 1080 THEN bx = bx + 20
ELSEIF bdirect = 3 THEN 'up right
IF by > 50 THEN by = by - 20
IF bx < 1080 THEN bx = bx + 20
ELSEIF bdirect = 4 THEN ' down left
IF by < 620 THEN by = by + 20
IF bx > 100 THEN bx = bx - 20
END IF
PAINT (bx, by), 1, 7
END SUB
SUB drawgrid
cx = 100: cy = 50
FOR i = 1 TO 1500
CIRCLE (cx, cy), 10, 7
cx = cx + 20
IF i MOD 50 = 0 THEN cx = 100: cy = cy + 20
NEXT i
END SUB
SUB Drawbricks
cx = 140: cy = 90
FOR k = 1 TO 5
FOR j = 1 TO 7
FOR i = 1 TO 4
IF POINT(cx, cy) = 0 AND brick(j, k) = 0 THEN
PAINT (cx, cy), 6, 7
ELSEIF brick(j, k) = 1 THEN
PAINT (cx, cy), 0, 7
END IF
cx = cx + 20
NEXT i
cx = cx + 60
NEXT j
cx = 140
cy = cy + 60
NEXT
END SUB
SUB control
'Galleoans INP(&H60) routine for keyboard input - logs multiple keys
'update keydown states
i& = INP(&H60)
DO
IF (i& AND 128) THEN KeyDown(i& XOR 128) = 0
IF (i& AND 128) = 0 THEN KeyDown(i&) = -1
i2& = i&
i& = INP(&H60)
LOOP UNTIL i& = i2&
DO: LOOP UNTIL INKEY$ = "" 'flush INKEY$ buffer
IF KeyDown(75) THEN
oldpx = px
IF px > 100 THEN
px = px - 20
pflag = 2
END IF
ELSEIF KeyDown(77) THEN
oldpx = px
IF px < 1020 THEN
px = px + 20
pflag = 2
END IF
I remember that game from Atari, back in the 1980's.
I liked the collision effects and the ball tracked perfectly. A lot going on for a smaller program.
I'm not sure if Galleon created graphics page flipping for QB64, I think he did. If so, you might want to add this concept to future projects to keep the shape of the paddle when in motion. I also wonder if there is a way to speed up redrawing of objects, to make the action faster?
Thanks Pete, the animation is the one thing that annoyed me, in the next version I will use multiple pages, and thanks to Alpha blending and _putimage it should be much smoother.
This version has been slightly modified by galleon to give better graphics and to use less CPU. It only took me a few hours ro make, and the core of it is the same as Brick Smash, in fact it was Copied directly from it.
Updated CODE - BE warned this is for QB64 ONLY!!!!!
'SLR Game - Pong v.01 - By Unseen Machine - Thanks To Galleon And Pete for the enhancements
DIM SHARED scrn AS LONG, KeyDown(127) AS LONG
DIM SHARED px AS INTEGER, cx AS INTEGER, py AS INTEGER, cy AS INTEGER, pflag AS INTEGER
DIM SHARED bx AS INTEGER, by AS INTEGER, bdirect AS INTEGER, cdirect AS INTEGER
DIM SHARED lwall AS INTEGER, rwall AS INTEGER, pscore AS INTEGER, cscore AS INTEGER
DIM SHARED oldpx AS INTEGER, cflag AS INTEGER, pdirect AS INTEGER, sflag AS INTEGER
DIM SHARED oldcx AS INTEGER
RANDOMIZE TIMER
bx = cx + 20
by = cy + 40
bd = INT(RND * 2) + 1
IF bd = 1 THEN bdirect = 2 ELSE bdirect = 4
END IF
END IF
colcnt = (bx - 100) / 20
rowcnt = (by - 50) / 20
GOSUB pclrpaddle
GOSUB cclrpaddle
bnow2! = TIMER
newnow! = TIMER
IF bnow2! - bnow! >= .04 THEN 'i found anything over .06 is almost impossible to beat
IF by = 70 THEN pscore = pscore + 1
IF by = 830 THEN cscore = cscore + 1
IF by > 70 AND by < 830 THEN
CALL ball
ELSE
sflag = 0
PAINT (bx, by), 0, 7
END IF
bnow! = TIMER
END IF
CALL control
CALL ccontrol
now! = TIMER
_DISPLAY 'manually refresh data to screen
_LIMIT 60 'limit of 30 frames per second to lower CPU usage, and allow input thread more processing time
LOOP
pclrpaddle:
FOR i = 1 TO 3
PAINT (oldpx, py), 0, 7
oldpx = oldpx + 20
NEXT
pdrawpaddle:
oldpx = px
FOR i = 1 TO 3
PAINT (px, py), 15, 7
px = px + 20
NEXT
px = oldpx
pflag = 0
RETURN
cclrpaddle:
FOR i = 1 TO 3
PAINT (oldcx, cy), 0, 7
oldcx = oldcx + 20
NEXT
cdrawpaddle:
oldcx = cx
FOR i = 1 TO 3
PAINT (cx, cy), 15, 7
cx = cx + 20
NEXT
cx = oldcx
RETURN
SUB ball
PAINT (bx, by), 0, 7
'cpu paddle contact
IF by < 450 THEN
IF POINT(bx + 20, by - 20) = 15 AND bdirect <> 5 THEN
IF cdirect = 1 THEN bdirect = 4
IF cdirect = 2 THEN
bd = INT(RND * 3) + 1
IF bd = 1 THEN bdirect = 2
IF bd = 2 THEN bdirect = 4
IF bd = 3 THEN bdirect = 6
END IF
IF cdirect = 3 THEN bdirect = 2
ELSEIF POINT(bx, by - 20) = 15 THEN
IF cdirect = 1 THEN bdirect = 4
IF cdirect = 2 THEN
bd = INT(RND * 3) + 1
IF bd = 1 THEN bdirect = 2
IF bd = 2 THEN bdirect = 4
IF bd = 3 THEN bdirect = 6
END IF
IF cdirect = 3 THEN bdirect = 2
ELSEIF POINT(bx - 20, by - 20) = 15 AND bdirect <> 5 THEN
IF cdirect = 1 THEN bdirect = 4
IF cdirect = 2 THEN
bd = INT(RND * 3) + 1
IF bd = 1 THEN bdirect = 2
IF bd = 2 THEN bdirect = 4
IF bd = 3 THEN bdirect = 6
END IF
IF cdirect = 3 THEN bdirect = 2
END IF
ELSEIF by > 450 THEN
'player paddle contact
IF POINT(bx + 20, by + 20) = 15 AND bdirect <> 6 THEN
IF pdirect = 1 THEN bdirect = 1
IF pdirect = 2 THEN bdirect = 5
IF pdirect = 3 THEN bdirect = 3
ELSEIF POINT(bx, by + 20) = 15 THEN
IF pdirect = 1 THEN bdirect = 1
IF pdirect = 2 THEN bdirect = 5
IF pdirect = 3 THEN bdirect = 3
ELSEIF POINT(bx - 20, by + 20) = 15 AND bdirect <> 6 THEN
IF pdirect = 1 THEN bdirect = 1
IF pdirect = 2 THEN bdirect = 5
IF pdirect = 3 THEN bdirect = 3
END IF
END IF
'Edges of Grid
IF bdirect = 3 AND bx = rwall THEN bdirect = 1
IF bdirect = 4 AND bx = lwall THEN bdirect = 2
IF bdirect = 1 AND bx = lwall THEN bdirect = 3
IF bdirect = 2 AND bx = rwall THEN bdirect = 4
IF bdirect = 1 THEN 'up left
by = by - 20
IF bx > 100 THEN bx = bx - 20
ELSEIF bdirect = 2 THEN 'down right
by = by + 20
IF bx < 1080 THEN bx = bx + 20
ELSEIF bdirect = 3 THEN 'up right
by = by - 20
IF bx < 1080 THEN bx = bx + 20
ELSEIF bdirect = 4 THEN ' down left
by = by + 20
IF bx > 100 THEN bx = bx - 20
ELSEIF bdirect = 5 THEN ' up
by = by - 20
ELSEIF bdirect = 6 THEN ' down
by = by + 20
END IF
PAINT (bx, by), 2, 7
END SUB
SUB ccontrol
IF cx < bx THEN
cdirect = 3
ELSEIF cx > bx THEN
cdirect = 1
ELSE
cdirect = 2
END IF
oldcx = cx
IF cdirect = 3 THEN
IF cx < rwall - 40 THEN cx = cx + 20
cflag = 2
ELSEIF cdirect = 1 THEN
IF cx > lwall THEN cx = cx - 20
cflag = 2
ELSE
cflag = 0
END IF
END SUB
SUB control
'Galleons INP(&H60) routine for keyboard input - logs multiple keys
'update keydown states
FOR z& = 1 TO 100
i& = INP(&H60)
IF (i& AND 128) THEN KeyDown(i& XOR 128) = 0
IF (i& AND 128) = 0 THEN KeyDown(i&) = -1
NEXT
IF KeyDown(75) THEN
oldpx = px
IF px > 100 THEN
px = px - 20
pflag = 2
END IF
pdirect = 1
ELSEIF KeyDown(77) THEN
oldpx = px
IF px < rwall - 40 THEN
px = px + 20
pflag = 2
END IF
pdirect = 3
ELSE
pdirect = 2
END IF
END SUB
SUB drawgrid
cx = 100: cy = 50
FOR i = 1 TO 2000
CIRCLE (cx, cy), 10, 7
IF i >= 951 AND i <= 1050 THEN PAINT STEP(0, 0), 7, 7
cx = cx + 20
IF i MOD 50 = 0 THEN
cx = 100
cy = cy + 20
END IF
NEXT
END SUB
This message has been edited by unseenmachine on Jun 12, 2010 10:04 AM
as if the world doesn't have enough of them. i threw it together over the last hour or so, so the quality isn't too good. i haven't tested it much. there is no victory condition, the game keeps going until you hit something or press escape. the snake grows until it's length reaches the maxsl constant. i have a classic delay loop, but it is commented out. the game currently uses a timer loop. you can, if you want, comment out the timer loop, and use the classic delay loop instead.
regards.
'CONST delayv& = 800000
CONST maxsl = 16 'maximum snake length
DECLARE SUB drawcirc (x%, y%)
DECLARE SUB drawmatrix ()
DEFINT A-Z
DECLARE SUB blankmatrix ()
DIM SHARED fld(0 TO 39, 0 TO 19)
TYPE snaket
x AS INTEGER
y AS INTEGER
END TYPE
DIM snake(0 TO maxsl) AS snaket
RANDOMIZE TIMER
FOR x = 0 TO 39
FOR y = 0 TO 19
fld(x, y) = 0
IF (x = 0) OR (x = 39) THEN fld(x, y) = 4
IF (y = 0) OR (y = 19) THEN fld(x, y) = 4
NEXT y, x
drawmatrix
SLEEP 2
snakel = 1
snake(0).x = 2
snake(0).y = 2
snakexdir = 1
snakeydir = 0
tx = -1
DO
fld(snake(0).x, snake(0).y) = 3
drawcirc snake(0).x, snake(0).y
IF tx = -1 THEN
DO
tx = INT(RND * 40)
ty = INT(RND * 20)
LOOP WHILE fld(tx, ty)
fld(tx, ty) = 5
END IF
drawcirc tx, ty
s! = TIMER
DO
c! = TIMER
IF c! < s! THEN s! = s! - 86400
LOOP UNTIL (c! - s!) >= .15
'FOR delay& = 0 TO delayv&: NEXT delay&
k$ = INKEY$
SELECT CASE k$
CASE CHR$(&H1B): SCREEN 0: WIDTH 80, 25: SYSTEM
CASE MKI$(&H4800): snakexdir = 0: snakeydir = 1
CASE MKI$(&H4B00): snakexdir = -1: snakeydir = 0
CASE MKI$(&H4D00): snakexdir = 1: snakeydir = 0
CASE MKI$(&H5000): snakexdir = 0: snakeydir = -1
END SELECT
SELECT CASE fld(snake(0).x + snakexdir, snake(0).y + snakeydir)
CASE 5
tx = -1
IF snakel < maxsl THEN snakel = snakel + 1: skip = -1
CASE 0
CASE ELSE: SCREEN 0: WIDTH 80, 25: SYSTEM
END SELECT
IF NOT skip THEN
fld(snake(snakel - 1).x, snake(snakel - 1).y) = 0
drawcirc snake(snakel - 1).x, snake(snakel - 1).y
END IF
skip = 0
FOR i = snakel - 1 TO 1 STEP -1
snake(i).x = snake(i - 1).x
snake(i).y = snake(i - 1).y
NEXT i
snake(0).x = snake(0).x + snakexdir
snake(0).y = snake(0).y + snakeydir
LOOP
SUB drawcirc (x, y)
cx = (x * 15) + 15
cy = ((20 - y) * 15) + 80
CIRCLE (cx, cy), 7, 8
PAINT (cx, cy), fld(x, y), 8
END SUB
SUB drawmatrix
CLS
SCREEN 12
cx = 25: cy = 80
FOR x = 0 TO 39
FOR y = 0 TO 19
drawcirc x, y
NEXT y, x
Works a dream in qb64. Shame that Ben never did respond to the tetris challenge though, but I am realy pleased that a least a few people have. I look forawrd too seeing a completed version in the future.