Posts: 1,813
Threads: 284
Joined: Mar 2003
http://www.sephplanet.com/lawn.zip
You can add it to your site if you want to. 
earn.
Posts: 3,368
Threads: 195
Joined: Jan 2003
it doesn't work.
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."
Visit www.neobasic.net to see rubbish in all its finest.
Posts: 1,813
Threads: 284
Joined: Mar 2003
Yeah it does.
earn.
Posts: 1,166
Threads: 62
Joined: Apr 2003
If it doesn't, try activating EMS yourself. Lazy bum.
am an asshole. Get used to it.
Posts: 3,368
Threads: 195
Joined: Jan 2003
oh... yeah... it works.
but the controls suck.
you suck.
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."
Visit www.neobasic.net to see rubbish in all its finest.
Posts: 292
Threads: 31
Joined: Apr 2003
Quote:oh... yeah... it works.
but the controls suck.
you suck.
That's what I love about you, Agamemnus: your constructive critizism and your innate kindness. Maybe instead of being a jerk, you could explain how he could improve.
But nothing personal, right?
Posts: 3,368
Threads: 195
Joined: Jan 2003
Seph is mean, so why can't I be mean to him? I'm sure he knows the game is unplayable...
Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."
Visit www.neobasic.net to see rubbish in all its finest.
Posts: 292
Threads: 31
Joined: Apr 2003
Quote:Seph is mean, so why can't I be mean to him?
*sigh*
Can't argue with that logic. :roll:
Posts: 1,813
Threads: 284
Joined: Mar 2003
The controls are excellent, you just have no fingers, because you're actually a very small elephant. Calm down, and you might be human.
EDIT: Here is the code. I am NOT going to organize, optimize, or in any way change it right now! Maybe tomorrow 
Code: DECLARE SUB LosePage ()
DECLARE SUB EndGame ()
DECLARE SUB WinPage ()
DECLARE SUB GrassCut (map() AS INTEGER)
DECLARE SUB setITEM (mapitem AS INTEGER, item AS INTEGER)
DECLARE FUNCTION getITEM% (mapitem AS INTEGER, item AS INTEGER)
DECLARE SUB MakeGrass (map() AS INTEGER)
DECLARE SUB FirstPage ()
'$INCLUDE: 'dqb2\directqb.bi'
CONST mRIGHT = 0, mLEFT = 1, mUP = 2, mDOWN = 3
CONST rBLANK = 0, rMAN = 1, rMOWER = 2, rGRASS = 4
CONST layerEDIT = 3
CONST iGRASS = 0, iMAN = 130, iMOWER = 260
DIM map(0 TO 16, 0 TO 10) AS INTEGER
TYPE playertype
x AS INTEGER
y AS INTEGER
END TYPE
TYPE mowertype
x AS INTEGER
y AS INTEGER
dir AS INTEGER
speed AS INTEGER
move AS INTEGER
END TYPE
MakeGrass map()
RANDOMIZE TIMER
IF DQBinit(1, 0, 0) THEN DQBclose: PRINT DQBerror$: END
DQBinstallKeyboard
DQBinitVGA
DIM images(1032) AS INTEGER
DEF SEG = VARSEG(images(0))
BLOAD "images.dat", VARPTR(images(0))
DEF SEG
DIM SHARED adjX%, adjY%
adjX% = 24
adjY% = 12
DIM man AS playertype
man.x = 0
man.y = 0
setITEM map(man.x, man.y), rMAN
DIM mower AS mowertype
mower.x = 16
mower.y = 10
mower.dir = mUP
mower.speed = 20
setITEM map(mower.x, mower.y), rMOWER
FirstPage
DO
IF TIMER - grasstime! > .3 THEN
grasswave% = NOT grasswave%
grasstime! = TIMER
END IF
IF TIMER - mowertime! > .1 THEN
mowershake% = NOT mowershake%
mowertime! = TIMER
END IF
DQBwait 2
setITEM map(man.x, man.y), rMAN
IF DQBkey(1) THEN EndGame
IF DQBkey(2) THEN WinPage
IF DQBkey(75) AND man.x > 0 THEN
IF getITEM(map(man.x - 1, man.y), rMOWER) THEN
mower.dir = mRIGHT
ELSE
man.x = man.x - 1
END IF
END IF
IF DQBkey(77) AND man.x < 16 THEN
IF getITEM(map(man.x + 1, man.y), rMOWER) THEN
mower.dir = mLEFT
ELSE
man.x = man.x + 1
END IF
END IF
IF DQBkey(72) AND man.y > 0 THEN
IF getITEM(map(man.x, man.y - 1), rMOWER) THEN
mower.dir = mDOWN
ELSE
man.y = man.y - 1
END IF
END IF
IF DQBkey(80) AND man.y < 10 THEN
IF getITEM(map(man.x, man.y + 1), rMOWER) THEN
mower.dir = mUP
ELSE
man.y = man.y + 1
END IF
END IF
setITEM map(man.x, man.y), rMAN
mower.move = mower.move + 1
IF mower.move = mower.speed THEN
setITEM map(mower.x, mower.y), rMOWER
setITEM map(mower.x, mower.y), rGRASS
IF mower.dir = mLEFT AND mower.x > 0 THEN
IF getITEM(map(mower.x - 1, mower.y), rMAN) THEN LosePage
mower.x = mower.x - 1
END IF
IF mower.dir = mRIGHT AND mower.x < 16 THEN
IF getITEM(map(mower.x + 1, mower.y), rMAN) THEN LosePage
mower.x = mower.x + 1
END IF
IF mower.dir = mUP AND mower.y > 0 THEN
IF getITEM(map(mower.x, mower.y - 1), rMAN) THEN LosePage
mower.y = mower.y - 1
END IF
IF mower.dir = mDOWN AND mower.y < 10 THEN
IF getITEM(map(mower.x, mower.y + 1), rMAN) THEN LosePage
mower.y = mower.y + 1
END IF
setITEM map(mower.x, mower.y), rMOWER
mower.move = 0
END IF
FOR y = 0 TO 10
FOR x = 0 TO 16
DQBbox layerEDIT, adjX% + (x * 16), adjY% + (y * 16), adjX% + (x * 16) + 15, adjY% + (y * 16) + 15, 0
IF getITEM(map(x, y), rGRASS) THEN
DQBmPut layerEDIT, adjX% + (x * 16), adjY% + (y * 16), VARSEG(images(iGRASS)), VARPTR(images(iGRASS)), grasswave%
ELSE
DQBboxF layerEDIT, adjX% + (x * 16), adjY% + (y * 16), adjX% + (x * 16) + 15, adjY% + (y * 16) + 15, 120
END IF
IF getITEM(map(x, y), rMAN) THEN DQBput layerEDIT, adjX% + (man.x * 16), adjY% + (man.y * 16), VARSEG(images(iMAN)), VARPTR(images(iMAN))
IF getITEM(map(x, y), rMOWER) THEN DQBput layerEDIT, adjX% + (mower.x * 16), adjY% + (mower.y * 16), VARSEG(images(iMOWER + (130 * ABS(mowershake%)))), VARPTR(images(iMOWER + (130 * ABS(mowershake%))))
NEXT x
NEXT y
DQBbox layerEDIT, adjX% - 2, adjY% - 2, adjX% + 273, adjY% + 177, 3
DQBcopyLayer layerEDIT, VIDEO
GrassCut map()
LOOP
REM $DYNAMIC
SUB EndGame
DQBremoveKeyboard
DQBclose
COLOR 7, 0
CLS
END
END SUB
REM $STATIC
SUB FirstPage
pal$ = STRING$(768, CHR$(0))
DQBgetPal pal$
DQBprint VIDEO, "Okay here's the deal:", CENTERED, 20, 15
DQBprint VIDEO, "Touch the lawnmower and it moves toward", CENTERED, 36, 43
DQBprint VIDEO, "you. If you get ran over, you die.", CENTERED, 52, 44
DQBprint VIDEO, "You must make it cut ALL the grass.", CENTERED, 68, 45
DQBprint VIDEO, "Oh yeah, one more thing...", CENTERED, 116, 40
DQBprint VIDEO, "If the lawnmower runs over grass it has", CENTERED, 148, 77
DQBprint VIDEO, "cut before, it leaves grass on it again.", CENTERED, 164, 79
DQBwaitKey KEYANY
DQBfadeTo 0, 0, 0
DQBsetPal pal$
DQBclearLayer layerEDIT
DQBclearLayer VIDEO
END SUB
REM $DYNAMIC
DEFSNG A-Z
FUNCTION getITEM% (mapitem AS INTEGER, item AS INTEGER)
IF item = 0 THEN getITEM% = mapitem% = item ELSE getITEM% = (mapitem% AND item) = item
END FUNCTION
REM $STATIC
DEFINT A-Z
SUB GrassCut (map() AS INTEGER)
FOR y = 0 TO 10
FOR x = 0 TO 16
IF getITEM(map(x, y), rGRASS) THEN grass% = 1
NEXT x
NEXT y
IF grass% = 0 THEN WinPage
END SUB
SUB LosePage
pal$ = STRING$(768, CHR$(0))
DQBgetPal pal$
DQBfadeTo 40, 0, 0
DQBfadeTo 0, 0, 0
DQBclearLayer VIDEO
DQBprint VIDEO, "You lost!!!", CENTERED, 60, 46
DQBprint VIDEO, "It was to be expected though...", CENTERED, 78, 47
DQBprint VIDEO, "Don't feel too bad. Nobody wins.", CENTERED, 96, 48
DQBprint VIDEO, "So try again!", CENTERED, 114, 54
DQBfadeIn pal$
DQBwaitKey KEYANY
EndGame
END SUB
SUB MakeGrass (map() AS INTEGER)
FOR y = 0 TO 10
FOR x = 0 TO 16
setITEM map(x, y), rGRASS
NEXT x
NEXT y
END SUB
REM $DYNAMIC
DEFSNG A-Z
SUB setITEM (mapitem AS INTEGER, item AS INTEGER)
IF item = 0 THEN mapitem = 0 ELSE mapitem = mapitem% XOR item
END SUB
REM $STATIC
DEFINT A-Z
SUB WinPage
pal$ = STRING$(768, CHR$(0))
DQBgetPal pal$
DQBfadeTo 40, 40, 40
DQBfadeTo 0, 0, 0
DQBclearLayer VIDEO
DQBprint VIDEO, "You won!?.. Wait a second...", CENTERED, 60, 46
DQBprint VIDEO, "I'm not quite sure how you did it,", CENTERED, 78, 47
DQBprint VIDEO, "but you managed to beat the game.", CENTERED, 96, 48
DQBprint VIDEO, "This is a damn near impossible feat.", CENTERED, 114, 49
DQBprint VIDEO, "Congrats =)", CENTERED, 150, 78
DQBfadeIn pal$
DQBwaitKey KEYANY
EndGame
END SUB
earn.
Posts: 1,166
Threads: 62
Joined: Apr 2003
Quote:IF DQBkey(2) THEN WinPage
Hehehe 
am an asshole. Get used to it.
|
