home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hall of Fame
/
HallofFameCDROM.cdr
/
prog1
/
4th_86.lzh
/
WORM.4TH
< prev
Wrap
Text File
|
1989-02-18
|
14KB
|
507 lines
( file: WORM)
(
This file contains the game "WORM". To use, configure for your
terminal by changing the DATA[ tables below. For the first try,
change only the critical ones, which are CRTLINES, CRTCOLS, and
CPLEADIN. To load: " WORM.4TH" LOAD (RANDOM.4TH must be on disk)
To execute: WORM
This can be made into a COM file with MAKECOM.4TH
)
OFF PRINTLOAD
" RANDOM.4TH" LOAD
DATA[ BYTE 24 ] CRTLINES ( number of lines on crt)
DATA[ BYTE 80 ] CRTCOLS ( number of columns)
DATA[ WORD 40 ] XPRTXDLY ( expert x direction delay factor)
DATA[ WORD 100 ] XPRTYDLY ( y )
DATA[ WORD 60H ] BEGXDLY ( beginner delay)
DATA[ WORD 160H ] BEGYDLY
DATA[ WORD 50 ] XDELAY ( delay used if player does not set options)
DATA[ WORD 150 ] YDELAY
DATA[ BYTE "A" ] UPKEY ( direction keys)
DATA[ BYTE "K" ] LEFTKEY
DATA[ BYTE "L" ] RIGHTKEY
DATA[ BYTE "Z" ] DOWNKEY
( next is clear screen string. If it is null, then line feeds are used)
DATA[ BYTE " ^27^^91^2J" 0 0 0 0 0 0 0 ] CLRSCREEN
( DATA[ BYTE 0 0 0 0 0 0 0 0 0 0 0 ] CLRSCREEN)
( next few tell how to position cursor)
DATA[ BYTE " ^27^^91^" 0 0 0 0 0 0 0 0 ] CPLEADIN ( lead-in esc seq.)
DATA[ BYTE " ;" 0 0 0 0 0 0 0 0 0 0 ] CPBETRC ( any thing needed between
row and column)
DATA[ BYTE 0 ] CPOFSET ( offsets)
DATA[ BYTE 0 ] COLBEFROW ( column before row flag)
DATA[ BYTE " H" 0 0 0 0 0 0 0 0 0 0 ] CPSUFIX ( esc seq. suffix)
DATA[ BYTE " -" 0 0 0 0 0 0 0 0 0 ] HBORDERCHAR ( playfield border horiz)
DATA[ BYTE " |" 0 0 0 0 0 0 0 0 0 ] VBORDERCHAR ( vertical)
DATA[ BYTE 0 0 0 0 0 0 0 0 0 0 0 ] TLCORNER ( the corners)
DATA[ BYTE 0 0 0 0 0 0 0 0 0 0 0 ] BLCORNER
DATA[ BYTE 0 0 0 0 0 0 0 0 0 0 0 ] TRCORNER
DATA[ BYTE 0 0 0 0 0 0 0 0 0 0 0 ] BRCORNER
DATA[ BYTE " #" 0 0 0 0 0 0 0 0 ] FOODCHAR
DATA[ BYTE " @" 0 0 0 0 0 0 0 0 0 ] WORMCHAR
DATA[ BYTE " ^7^" 0 0 0 0 0 0 0 0 0 ] BELLCHAR
DATA[ BYTE " " 0 0 0 0 0 0 0 0 0 ] BLANKCHAR
DATA[ BYTE " ^13 10 0 0 0 0 0 0^" 0 0 0 0 0 ] CRLFCHAR ( note nulls for delay)
DATA[ BYTE 0 0 0 0 0 0 0 0 0 0 0 ] INITSTR ( terminal init string)
DATA[ BYTE 0 0 0 0 0 0 0 0 0 0 0 ] UNINITSTR ( un-init)
DATA[ BYTE 00001000B ] OPTIONBITS
( bit 0 means move food,
bit 1 means attract mode,
bit 2 means 2 rooms
bit 3 means sound)
DATA[ WORD 20 ] OPRESCALE ( food value countdown)
DATA[ WORD 0 ] SCORE
DATA[ WORD 0 ] WORMLENGTH
DATA[ WORD 0 ] HISCORE
DATA[ WORD 0 ] HILENGTH
DATA[ BYTE " " ] INITIALS
DATA[ BYTE 10 ] INITFOODV ( initial food value)
DATA[ WORD 5 ] IWLENSHORT ( initial worm lengths)
DATA[ WORD 25 ] IWLENLONG
DATA[ WORD 5 ] INITWORMLENGTH
2 BLOCK PLAYFIELDSIZE
132 64 * BLOCK PLAYFIELD
1 BLOCK XHEAD
1 BLOCK YHEAD
1 BLOCK XTAIL
1 BLOCK YTAIL
1 BLOCK XFOOD
1 BLOCK YFOOD
1 BLOCK DIRECTION
1 BLOCK FOODEATEN
1 BLOCK COLLISION
1 BLOCK FOODV
2 BLOCK PRESCALE
: INKEY ( sample input, return 0 if no input else return ASCII)
0FFH 6 MON2 ;
: GETKEY
0 BEGIN
DROP INKEY DUP
END
;
CODE UPCASE
H POP, A L MOV, "a" CPI, IFNC
"z" 1+ CPI, IFC
0DFH ANI, L A MOV,
THEN
THEN
;PUSH
: .B ( output char on top of stack)
6 MON1 ;
: GETUPCASE
0 BEGIN DROP GETKEY UPCASE DUP END[ "A" THRU "Z" ] DUP .B ;
: .S ( output string whose addr is on tos)
DUPB@ ?DUP IF
1 DO
1+ DUPB@ .B
LOOP
THEN
DROP ;
: .S1
INITSTR .S .S UNINITSTR .S
;
: YESNO
" ^13 10^" .S .S " (Y/N)? " .S
0 BEGIN DROP INKEY 0DFH AND dup END[ "Y" "N" ]
DUP .B "Y" =
;
: .2
10 /MOD "0" + .B "0" + .B
;
: .4 ( print 4 digit number)
1000 /MOD "0" + .B 100 /MOD "0" + .B .2
;
: SETCUR ( set cursor: tos = line, nos = col)
COLBEFROW B@ IF ( column before row flag set)
SWAP ( swap args on tos)
THEN
CPLEADIN .S ( print esc seq)
CPOFSET B@ + .L ( .B) ( print line (or col))
CPBETRC .S ( print seq between row and col)
CPOFSET B@ + .L ( .B) ( print column (or line))
CPSUFIX .S ( print remaining esc seq) ;
: CLRCRT ( clear screen)
( first clear the playfield image)
PLAYFIELDSIZE @ 1- 0 DO 0 PLAYFIELD I + B! LOOP
( now the screen)
CLRSCREEN B@ IF ( there is a control code to do it)
CLRSCREEN .S
ELSE ( use line feeds)
0 CRTLINES B@ 1- SETCUR
CRTLINES B@ 3 * 1 DO
CRLFCHAR .S
LOOP
THEN
;
: DRAWBORDER
( first set the border in the playfield image)
PLAYFIELD ( do top)
CRTCOLS B@ 1 DO 1 OVER B! 1+ LOOP DROP
PLAYFIELD PLAYFIELDSIZE @ + CRTCOLS B@ - ( do bottom)
CRTCOLS B@ 1 DO 1 OVER B! 1+ LOOP DROP
PLAYFIELDSIZE @ 1- 0 DO
1 PLAYFIELD I + B! ( left)
1 PLAYFIELD I + CRTCOLS B@ 1- + B! ( right)
CRTCOLS B@ +LOOP
( do rooms if needed)
OPTIONBITS B@ 4 AND IF
PLAYFIELD CRTLINES B@ 2 / CRTCOLS B@ * + 10 +
CRTCOLS B@ 20 - 1 DO
1 OVER B! 1+
LOOP DROP
THEN
( now draw on CRT)
1 0 SETCUR
CRTCOLS B@ 2 - 1 DO HBORDERCHAR .S LOOP
1 CRTLINES B@ 1- SETCUR
CRTCOLS B@ 2 - 1 DO HBORDERCHAR .S LOOP
CRTLINES B@ 2 - 1 DO
0 I SETCUR VBORDERCHAR .S
CRTCOLS B@ 1- I SETCUR VBORDERCHAR .S
LOOP
0 0 SETCUR TLCORNER .S
0 CRTLINES B@ 1- SETCUR BLCORNER .S
CRTCOLS B@ 1- 0 SETCUR TRCORNER .S
CRTCOLS B@ 1- CRTLINES B@ 1- SETCUR BRCORNER .S
OPTIONBITS B@ 4 AND IF
10 CRTLINES B@ 2 / SETCUR
CRTCOLS B@ 20 - 1 DO HBORDERCHAR .S LOOP
THEN
;
: COMPUTERMOVE
DIRECTION B@ CASE
00010100B OF ( going down)
YFOOD B@ YHEAD B@ > IF
00010100B ( continue)
ELSE ( go x)
XHEAD B@ XFOOD B@ < IF
10000100B ( go right)
ELSE
01000100B ( go left)
THEN
THEN
ENDOF
00100100B OF ( going up)
YHEAD B@ YFOOD B@ > IF
00100100B ( continue)
ELSE ( go x)
XHEAD B@ XFOOD B@ < IF
10000100B ( go right)
ELSE
01000100B ( go left)
THEN
THEN
ENDOF
01000100B OF ( going left)
XHEAD B@ XFOOD B@ > IF
01000100B ( continue)
ELSE ( go y)
YHEAD B@ YFOOD B@ > IF
00100100B ( go up)
ELSE
00010100B ( go down)
THEN
THEN
ENDOF
10000100B OF ( going right)
XFOOD B@ XHEAD B@ > IF
10000100B ( continue)
ELSE ( go y)
YHEAD B@ YFOOD B@ > IF
00100100B ( go up)
ELSE
00010100B ( go down)
THEN
THEN
ENDOF
DROP 0
ENDCASE
DIRECTION B!
;
: CHECKINPUT
INKEY ?DUP IF
UPCASE CASE
DOWNKEY B@ OF 00010100B DIRECTION B! ENDOF
UPKEY B@ OF 00100100B DIRECTION B! ENDOF
LEFTKEY B@ OF 01000100B DIRECTION B! ENDOF
RIGHTKEY B@ OF 10000100B DIRECTION B! ENDOF
( else) DROP
ENDCASE
THEN
;
: ARRAY
CRTCOLS B@ * + PLAYFIELD + ;
: MOVEWORM
DIRECTION B@ XHEAD B@ YHEAD B@ ARRAY B! ( set link to new head)
DIRECTION B@ CASE
00010100B OF YHEAD B@ 1+ YHEAD B! ENDOF
00100100B OF YHEAD B@ 1- YHEAD B! ENDOF
01000100B OF XHEAD B@ 1- XHEAD B! ENDOF
10000100B OF XHEAD B@ 1+ XHEAD B! ENDOF
DROP ( just in case)
ENDCASE
XHEAD B@ YHEAD B@ SETCUR WORMCHAR .S
XHEAD B@ YHEAD B@ ARRAY DUPB@ IF
1 COLLISION B! DUPB@ 010B AND IF
1 FOODEATEN B!
THEN
THEN
0100B SWAP B! ( set new head in image)
COLLISION B@ 0= IF
XTAIL B@ YTAIL B@ SETCUR BLANKCHAR .S ( erase old tail on crt)
XTAIL B@ YTAIL B@ ARRAY DUPB@ CASE
00010100B OF YTAIL B@ 1+ YTAIL B! ENDOF
00100100B OF YTAIL B@ 1- YTAIL B! ENDOF
01000100B OF XTAIL B@ 1- XTAIL B! ENDOF
10000100B OF XTAIL B@ 1+ XTAIL B! ENDOF
DROP ( just in case)
ENDCASE
0 SWAP B! ( delete old tail from image)
THEN ;
: MOVEFOOD
RANDOM 7 AND DUP 4 < IF
CASE
0 OF 1 0 ENDOF
1 OF -1 0 ENDOF
2 OF 0 1 ENDOF
3 OF 0 -1 ENDOF
ENDCASE
XFOOD B@ + SWAP YFOOD B@ + OVER OVER ARRAY DUPB@ IF
3 KILL
ELSE
0 XFOOD B@ YFOOD B@ OVER OVER SETCUR BLANKCHAR .S ARRAY B!
010B SWAP B! OVER OVER SETCUR FOODCHAR .S YFOOD B! XFOOD B!
THEN
ELSE
DROP
THEN ;
: NEWFOOD
BEGIN
( mfb)
RANDOM CRTCOLS B@ 2 - /MOD DROP 2+ ( 1+ ) XFOOD B!
RANDOM CRTLINES B@ 2 - /MOD DROP 2+ ( 1+ ) YFOOD B!
XFOOD B@ YFOOD B@ ARRAY B@
0= END
XFOOD B@ YFOOD B@ OVER OVER ARRAY 010B SWAP B!
SETCUR FOODCHAR .S ( display food character)
OPTIONBITS B@ 8 AND IF ( want sound)
OPTIONBITS B@ 2 AND 0= IF ( and not attract)
BELLCHAR .S
THEN
THEN ;
: FOODVAL
-1 PRESCALE +! PRESCALE @ 0= IF
OPRESCALE @ PRESCALE !
FOODV B@ 1 > IF
FOODV B@ 1- FOODV B! 16 0 SETCUR FOODV B@ .2
THEN
THEN
;
: WORMGAME
INITSTR .S
CLRCRT DRAWBORDER
SCORE @ HISCORE @ > IF
SCORE @ HISCORE ! WORMLENGTH @ HILENGTH !
THEN
10000100B DIRECTION B! ( initial direction)
INITWORMLENGTH @ DUP WORMLENGTH !
1- 0 DO
10 I + 10 OVER OVER ARRAY 10000100B SWAP B!
OVER OVER SETCUR WORMCHAR .S
YHEAD B! XHEAD B!
LOOP
10 YTAIL B! 10 XTAIL B!
0 SCORE !
NEWFOOD
(
1 2 3
0123456789012345678901234567890123456789
**0000***0000***00***0000***0000***ABC**
SCORE LENGTH FVAL HISCOR HILENG INIT
)
OPRESCALE @ PRESCALE !
( mfbok)
21 0 SETCUR HISCORE @ .4
28 0 SETCUR HILENGTH @ .4
35 0 SETCUR INITIALS .S
BEGIN
( mfbok)
2 0 SETCUR SCORE @ .4
9 0 SETCUR WORMLENGTH @ .4
16 0 SETCUR INITFOODV B@ DUP FOODV B! .2
0 FOODEATEN B!
0 COLLISION B!
BEGIN
DIRECTION B@ 0F0H AND 64 >= IF
XDELAY
ELSE
YDELAY
THEN
OPTIONBITS B@ 2 AND IF COMPUTERMOVE THEN ( attract)
@ 1 DO CHECKINPUT LOOP
OPTIONBITS B@ 1 AND IF MOVEFOOD THEN
MOVEWORM
FOODVAL
COLLISION B@
END
FOODEATEN B@ IF
NEWFOOD 1 WORMLENGTH +! FOODV B@ SCORE +!
THEN
FOODEATEN B@ 0=
END
0 1 SETCUR
UNINITSTR .S ;
: DELAY
0 SWAP 0 DO
2 1 / dup / DROP INKEY ?DUP IF
SWAP DROP EXIT
THEN
LOOP ;
: WORM
CRTLINES B@ CRTCOLS B@ * PLAYFIELDSIZE !
CLRCRT 0 0 SETCUR
" ^13 10 10^Welcome to ..." .S
" ^13 10 10^ W O R M W A R S" .S
BEGIN
" ^13 10 10^Need Instructions (Y/N)? " .S
0 0 BEGIN
DROP 1+ INKEY DUP
END[ "Y" "y" "N" "n" ]
0DFH AND DUP .B SWAP ( get seed)
1 OR DUP 13 * DUP 5 * RANDOMIZE
"Y" = IF ( ins. wanted)
" ^13 10^Objective: Maneuver the WORM around the " .S
" ^13 10^ room trying to eat the food as it" .S
" ^13 10^ appears. Do this in the least amount" .S
" ^13 10^ of time. The quicker you eat the food," .S
" ^13 10^ the higher your score will be." .S
" ^13 10 10^Two small snags:" .S
" ^13 10^ 1. The more food that you eat, the" .S
" ^13 10^ longer the worm gets." .S
" ^13 10^ 2. If the worm runs into a wall or " .S
" ^13 10^ itself - the game is then over" .S
" ^13 10 10^Hit any key to continue" .S
BEGIN INKEY END
" ^13 10 10^Cast: WORM= " .S WORMCHAR .S1
" ^13 10^ FOOD= " .S FOODCHAR .S1
" ^13 10^ WALLS= " .S HBORDERCHAR .S1 20H .B VBORDERCHAR .S1
" ^13 10 10^Directions: UP= " .S UPKEY B@ .B
" ^13 10^ LEFT= " .S LEFTKEY B@ .B
" ^13 10^ RIGHT= " .S RIGHTKEY B@ .B
" ^13 10^ DOWN= " .S DOWNKEY B@ .B
" ^13 10 10^Good Luck !" .S
THEN
" ^13 10 10^Want to set options" YESNO IF
" High speed" YESNO IF
XPRTXDLY @ XDELAY ! XPRTYDLY @ YDELAY !
ELSE
BEGXDLY @ XDELAY ! BEGYDLY @ YDELAY !
THEN
OPTIONBITS B@ ( set option bits)
" Moving food" YESNO IF 1 OR ELSE FEH AND THEN
" Two rooms" YESNO IF 4 OR ELSE FBH AND THEN
" Want sound" YESNO IF 8 OR ELSE F7H AND THEN
OPTIONBITS B!
" Long worm" YESNO IF
IWLENLONG B@
ELSE
IWLENSHORT B@
THEN
INITWORMLENGTH B!
" Want to redefine movement keys" YESNO IF
" ^13 10^Up key " .S GETKEY UPCASE UPKEY B!
" ^13 10^Down key " .S GETKEY UPCASE DOWNKEY B!
" ^13 10^Left key " .S GETKEY UPCASE LEFTKEY B!
" ^13 10^Right key " .S GETKEY UPCASE RIGHTKEY B!
THEN
THEN
BEGIN
WORMGAME
1000 1 DO
INKEY
DROP LOOP
( mfbok)
2 2 ( 1 ) SETCUR " Score Length Food Hi Hi Best" .S
2 3 ( 2 ) SETCUR " Value Score Length Player" .S
SCORE @ HISCORE @ > IF
OPTIONBITS B@ 2 AND IF ( attract mode)
" I " INITIALS $!
ELSE
2 3 SETCUR " Initials ?" .S
INITIALS 3 1 DO
I 34 + 0 SETCUR GETUPCASE OVER I + B!
LOOP
DROP
THEN
THEN
( mfbok)
2 13 SETCUR " ESC to end; any other to continue" .S
OPTIONBITS B@ 2 AND 0= 10000 * 3500 + DELAY DUP IF ( key pressed)
OPTIONBITS B@ FDH AND ( clear attract mode)
ELSE
OPTIONBITS B@ 2 OR ( set attract mode)
THEN
OPTIONBITS B!
27 =
END
CLRCRT
" Do you want to start over" YESNO 0=
END
;