Jump to content
moulinaie

Precompiler for "MyLittleCompiler"

Recommended Posts

Hello,

 

I started working again on My Little Compiler. I know that the codes I use are not easy to memorize and to use. But, with so little space in LowRam I couldn't imagine to use a "hig level language" style.

 

So, I am currently working on a PC program that accepts a kind of high level language mixed with Basic lines and that outputs a whole XB source code to be used with "MyLittleCompiler" (MLC).

 

For example, here is how you could write the GCD program (PGCD in french):

 

100 CALL CLEAR::DIM A$(5),S$(5)

$MLC N 110 10 3000 ; line to include all for compilation

1000 INPUT "A=":A

1010 INPUT "B=":B

1030 CALL LINK("PGCD",A,B,C)

1040 PRINT "PGCD=";C

1050 END

$PGCD ; here starts the program that will be converted to MLC codes

GETPARAM 1 A

GETPARAM 2 B

LABEL 1

DIV A B

IF=THEN 2

LET A B

LET B Z

GOTO 1

LABEL 2

PUTPARAM 3 B

$$

$END

 

After my Precompiler has worked on it, you get this:

(lines 110 to 160 added by $MLC directive)

(lines 3000- are the MLC codes)

 

100 CALL CLEAR::DIM A$(5),S$(5)

110 CALL INIT::PRINT "LOADING COMPILER..."::CALL LOAD("DSK1.MLCO")

120 RESTORE 3000::READ T$::I=0::If T$="*" THEN 160

130 I=I+1::READ A$(I)::IF A$(I)<>"*" THEN 130

140 A$(I)=""::IF T$="P" THEN CALL LINK("COMPIL",A$()) ELSE CALL LINK("SOUND",A$(),S$())

150 IF SEG$(A$(1),1,2)<>"OK" THEN PRINT T$;" ERROR ";A$(1)::END

160 PRINT "COMPILATION OK!"

1000 INPUT "A=":A

1010 INPUT "B=":B

1030 CALL LINK("PGCD",A,B,C)

1040 PRINT "PGCD=";C

1050 END

3000 DATA P,PGCD

3010 DATA "G1A G2B L1 /AB ?=2 =AB =BZ B1 L2 P3B"

3020 DATA *

3030 DATA *

 

I'll give you more infos when the program is on line!

 

Guillaume.

 

The link to MLC:

 

http://gtello.pagesperso-orange.fr/mlc_e.htm

(or french: http://gtello.pagesperso-orange.fr/mlc_f.htm)

Share this post


Link to post
Share on other sites

Cool! Looking forward seeing how this further develops. So the precompiler runs on the PC. What language is it written in? How do you parse the text-file, etc.

Can you give some more details? ;-)

 

By the way: did you know that rocky007 wrote a full game using MLC. It's called KABOOM!

 

Check here: http://www.atariage.com/forums/topic/186539-kaboom-for-ti-994a/page__view__findpost__p__2352215

Share this post


Link to post
Share on other sites

Cool! Looking forward seeing how this further develops. So the precompiler runs on the PC. What language is it written in? How do you parse the text-file, etc.

Can you give some more details? ;-)

 

By the way: did you know that rocky007 wrote a full game using MLC. It's called KABOOM!

 

Check here: http://www.atariage....ost__p__2352215

 

In order:

It is written in Pure Basic under Windows. But I only use the "console" with an old fashioned menu with numbers to type in.

The text files is parsed this way:

1) read a line

2) if this line starts with a digit -> then copy it to the destination, it is a BASIC line

3) if the line starts with $ then the precompiler has something to do!

3-a: if it is $MLC it includes the code for loading the compiler and compling (parameters are the desired line numbers)

3-b: if it is $SND these are data for creating a sound

3-c else it is $xxxxxx with a program name and next lines are interpretated as MLC high level codes (with only one instruction per line for now)

 

Well, that's the whole thing.

 

No, I didn't know that someone ended a project using MLC! That's the problem with free software for download, there are few people that sends feed back on your work. But I'm really happy to learn that. I'd like to put links on my page to his to show that my compiler is "useable"!!!

 

Thats for the infos and interest.

 

Guillaume.

Share this post


Link to post
Share on other sites

The PreCompiler is on line !!!

It's a version 1.00, surely not really bug-resistant, but it works!

 

I wrote a page to present it, you can download it from this page (both in french and english):

 

 

http://gtello.pagesperso-orange.fr/precompiler.htm

 

Enjoy,

Guillaume.

 

PS: hi Rocky007: are you the one who told me about the bug in DIVISION? If so : thanks a lot!!

Share this post


Link to post
Share on other sites

I just checked the source code for Pong! and it looks very impressive.

You should post the pong source code for others to have a look to.

 

On a sidenote. I want to do something similar for my spectra2 runtime too. Basically a crosscompiler on the PC.

Last year I started working on the language syntax and had a first draft of the scanner (Using goldparser which is great for prototyping: http://www.devincook.com/goldparser/ )

Did not give up on the project, but it's not likely gonna happen in 2012. Barely have TI time and need to finish Tutankham first.

 

At this time, I'm considering if I would include a small interpreter in spectra2 or if I would make it output pure assembly language.

Edited by retroclouds

Share this post


Link to post
Share on other sites

I just checked the source code for Pong! and it looks very impressive.

You should post the pong source code for others to have a look to.

 

It can be viewed on my page (with better tabulations) for readability!

http://gtello.pagesperso-orange.fr/precompiler.htm

 

(at the botton of the page with pink background).

 

Guillaume.

Share this post


Link to post
Share on other sites

that should work here too, see

 

sub routine
  print "hello world"
  read key
  if val=13 then
     goto newline
  else
     goto newpage
  end if
end sub

 

To do this you need to put a code tag around your source code as seen below. Just remove the extra space characters between the code tag for it to take effect.

 

[ code ] my code here [ /code ]

 

 

Share this post


Link to post
Share on other sites

Okay Retroclouds, let's try it!

 

Here is the PONG source code with the language provided by the PreCompiler:

 

; PONG game using XB and MLC with Precompiler
; 2011 [email protected]

100 CALL INIT::CALL CLEAR::DIM A$(35),S$(3)

; load compiler and compiles game and sounds

110 GOSUB 1000

; ball, paddle, net and field definitions

140 CALL CHAR(96,"60F0F0F0F0F0F060")::CALL CHAR(100,"60F0F06000000000")
150 CALL CHAR(97,"8855225588552255")::CALL CHAR(98,"FFFFFFFFFFFFFFFF")::CALL CHAR(99,"0000000000000000")

; prepares screen

160 CALL CLEAR::CALL SCREEN(1)::CALL COLOR(9,16,10)
170 FOR I=1 TO 8::CALL COLOR(I,4,1)::NEXT I
180 RESTORE 900::READ M$,N$,P$::READ SP(1),SP(2),SP(3),SP(4)
190 DISPLAY AT(1,13):"PONG"
200 DISPLAY AT(2,1):M$
210 FOR I=3 TO 19::DISPLAY AT(I,1):N$::NEXT I
220 DISPLAY AT(11,1)$::DISPLAY AT(20,1):M$
230 DISPLAY AT(21,2):"LEFT (X-E)     RIGHT (I-M)"
240 SC(1)=0::SC(2)=0::START=1::SPEED=2::CALL MAGNIFY(2)

; display little menu and wait for SPACE to start

250 DISPLAY AT(24,1):"SPACE=START  S=SPEED  Q=QUIT"
260 DISPLAY AT(22,7):SC(1)::DISPLAY AT(22,21):SC(2)::GOSUB 400::IF K$<>" " THEN 250

; sprites 2 and 3 are the paddles, sprite 1 the ball

270 CALL SPRITE(#2,96,5,16,24)::CALL SPRITE(#3,96,14,136,224)
280 CALL SPRITE(#1,100,13,120*START-102,184*START-152)

; call assembly routine to play

290 CALL LINK("PLAY",S$(),START,SP(SPEED),WIN)

; upon return, WIN is the winner!

300 SC(WIN)=SC(WIN)+1:: START=3-START::GOTO 260

; quit game, the assembly routine is deleted from ram

310 CALL LINK("POP",A)::PRINT A
320 END

; menu key

400 CALL KEY(0,K,S)::K$=CHR$(ABS(K))::IF K$=" " THEN RETURN
410 IF K$="S" OR K$="s" THEN 420
415 IF K$="Q" OR K$="q" THEN 310 ELSE 400
420 DISPLAY AT(24,1):"SELECT SPEED FROM 1 TO 4:";SPEED
430 ACCEPT AT(24,27)SIZE(-1)BEEP:SPEED
440 RETURN

; field definition

900 DATA bbbbbbbbbbbbbaabbbbbbbbbbbbb
910 DATA bccccccbcccccaacccccbccccccb
920 DATA bccccccbbbbbbaabbbbbbccccccb

; speed table 1 to 4

930 DATA 10,20,35,50

; includes here the loader from line 1000 and DATA from line 2000
; --> to load the compiler (normal mode) use $MLC N ...
; --> to use the Fast Loader use $MLC F ...
; --> If compiler in memory and you don't want it to be loaded, remove CALL INIT and use $MLC D ...

$MLC F 1000 10 2000
1900 RETURN

; sound definitions

$SND 1	; ball touches paddle 1
FA440VA0VN15D2 VA2D3 VA4D4 VA6D5 VA8D6,VA12D7 VA14D8 VA15D0
$$
$SND 2	; ball touches paddle 2
FA220VA0VN15D2 VA2D3 VA4D4 VA6D5 VA8D6,VA12D7 VA14D8 VA15D0
$$
$SND 3	; ball touches border
FN5VN8VA15D1 VN6D1 VN4D1 VN6D1 VN8D2,VN12D2 VN15D0
$$

; game routine

$PLAY
GETPARAM 2 S		; S=start player (1/2)
GETPARAM 3 H		; horizontal speed
RND			; random number in Z
DIV Z H			; reminder (so Z<H)
LET G Z			; vertical speed!
LET M 1			; default player 1
COMPARE S 1		
IF=THEN a		; if start player is 1, ok
	NEG G		; else modifies motion and M=2
	NEG H
	INC M
LABEL a
SMAX 1			; one sprite with auto motion
SMOTION 1 G H		; ball starts !
SOUND M			; with a paddle sound
SPOSITION 2 A B		; get positions of both paddles
SPOSITION 3 C D
LABEL 0
INTERRUPT		; enables interrupt
KEY 1			; read keyboard left, key in K and COMPARE K 0 performed
IF<THEN 3		; if negative then no key pressed, skip!
IF<>THEN 2		; if not equal, it is not X
	INC A		; here "X"=down, A=A+1
	GOTO 1
LABEL 2
COMPARE K 18		; if "Q" then quit
IF=THEN x
COMPARE K 5		; is it "E"?
IF<>THEN 3		; no, skip
	DEC A		; here "E"=up, A=A-1
LABEL 1
LIMIT 16 136 A		; ensure A is in the range
SLOCATE 2 A B		; and set new paddle position
LABEL 3
GOSUB b			; manages ball movement
KEY 2			; read keyboard right, key in K and COMPARE K 0 performed
IF<THEN 6		; no key, skip
IF<>THEN 5		; if not 0, it is not "M"
	INC C		; if "M"=down, C=C+1
	GOTO 4
LABEL 5
COMPARE K 5		; is it "I"?
IF<>THEN 6		; no, skip
	DEC C		; if "I"=up, C=C+1
LABEL 4
LIMIT 16 136 C		; ensure C is in the range
SLOCATE 3 C D		; new position
LABEL 6
GOSUB b			; manages ball movement
GOTO 0			; and back to paddle one !!!
SLABEL b
SPOSITION 1 E F		; get ball position
LIMIT 16 144 E		; is the vertical position in the field?
IF=THEN 8		; yes, so skip
	NEG G		; else, reverse motion
	SMOTION 1 G H	; reflexion
	SLOCATE 1 E F	; new location
	SOUND 3		; and border sound
LABEL 8
LIMIT 24 224 F		; is the horizontal potition in the field?
IF<>THEN x		; if not, game has ended!
LIMIT 32 216 F		; else, are we far from the paddles?
IF=THEN q		; yes, nothing to do
IF>THEN r		; if over 216 then work with paddle 2
	LET G A		; else take vertical position of...
	LET M 1		; ...paddle 1
	GOTO z
LABEL r
	LET G C		; take vertical position of...
	LEt M 2		; ...paddle 2
LABEL z
SUB G E			; vertical distance G-E
LIMIT -16 8 G		; is it in -16,8 ?
IF<>THEN q		; no, so, no contact
	ADD G 4		; else ball touches the paddle M
	ADD G G		; G=2*(vertical distance+4) new vertical speed
	NEG G		; reflexion
	NEG H		; idem
	SMOTION 1 G H	; new ball motion
	SLOCATE 1 E F	; new location
	SOUND M		; and sound for paddle contact
LABEL q
RETURN			; back to players keys
LABEL x
SMAX 0			; end of game, stop every sprite
LET R 1			; default winner
COMPARE F 124
IF>THEN y		; if position over 124, winner is 1
	INC R		; else winner is 2
LABEL y
PUTPARAM 4 R		; return winner
$$
$END

Share this post


Link to post
Share on other sites

And now the compiled version of PONG ready to use on a TI-99/4A after PreCompiler worked on it:

(I've just notices there are two CALL INIT...)

 

Guillaume.

 

(lines 1000-1080 added by $MLC directive)

(lines 2000-2100 are the sound definitions)

lines 2110-2210 are the program ready for MLC compilation)

 

100 CALL INIT::CALL CLEAR::DIM A$(35),S$(3)
110 GOSUB 1000
140 CALL CHAR(96,"60F0F0F0F0F0F060")::CALL CHAR(100,"60F0F06000000000")
150 CALL CHAR(97,"8855225588552255")::CALL CHAR(98,"FFFFFFFFFFFFFFFF")::CALL CHAR(99,"0000000000000000")
160 CALL CLEAR::CALL SCREEN(1)::CALL COLOR(9,16,10)
170 FOR I=1 TO 8::CALL COLOR(I,4,1)::NEXT I
180 RESTORE 900::READ M$,N$,P$::READ SP(1),SP(2),SP(3),SP(4)
190 DISPLAY AT(1,13):"PONG"
200 DISPLAY AT(2,1):M$
210 FOR I=3 TO 19::DISPLAY AT(I,1):N$::NEXT I
220 DISPLAY AT(11,1) $::DISPLAY AT(20,1):M$
230 DISPLAY AT(21,2):"LEFT (X-E)	 RIGHT (I-M)"
240 SC(1)=0::SC(2)=0::START=1::SPEED=2::CALL MAGNIFY(2)
250 DISPLAY AT(24,1):"SPACE=START  S=SPEED  Q=QUIT"
260 DISPLAY AT(22,7):SC(1)::DISPLAY AT(22,21):SC(2)::GOSUB 400::IF K$<>" " THEN 250
270 CALL SPRITE(#2,96,5,16,24)::CALL SPRITE(#3,96,14,136,224)
280 CALL SPRITE(#1,100,13,120*START-102,184*START-152)
290 CALL LINK("PLAY",S$(),START,SP(SPEED),WIN)
300 SC(WIN)=SC(WIN)+1:: START=3-START::GOTO 260
310 CALL LINK("POP",A)::PRINT A
320 END
400 CALL KEY(0,K,S)::K$=CHR$(ABS(K))::IF K$=" " THEN RETURN
410 IF K$="S" OR K$="s" THEN 420
415 IF K$="Q" OR K$="q" THEN 310 ELSE 400
420 DISPLAY AT(24,1):"SELECT SPEED FROM 1 TO 4:";SPEED
430 ACCEPT AT(24,27)SIZE(-1)BEEP:SPEED
440 RETURN
900 DATA bbbbbbbbbbbbbaabbbbbbbbbbbbb
910 DATA bccccccbcccccaacccccbccccccb
920 DATA bccccccbbbbbbaabbbbbbccccccb
930 DATA 10,20,35,50
1000 CALL INIT::PRINT "LOADING LOADER..."::CALL LOAD("DSK1.LODBIN")::RESTORE 2000
1010 PRINT "OPENING BINARY FILE..." :: OPEN #1:"DSK1.MLCBIN",INPUT,INTERNAL,FIXED 128
1020 PRINT "READING BLOCS"; :: I=0
1030 I=I+1 :: INPUT #1:A$(I) :: PRINT ".";::IF EOF(1)=0 THEN 1030
1040 CLOSE #1 :: PRINT :: PRINT "COPYING";I;"BLOCS TO MEM..." :: CALL LINK("LODBIN",A$())::PRINT "MY LITTLE COMPILER READY!"
1050 READ T$::I=0::IF T$="*" THEN 1090
1060 I=I+1::READ A$(I)::IF A$(I)<>"*" THEN 1060
1070 A$(I)=""::IF T$="P" THEN CALL LINK("COMPIL",A$()) ELSE CALL LINK("SOUND",A$(),S$())
1080 IF SEG$(A$(1),1,2)="OK" THEN 1050 ELSE PRINT T$;" ERROR ";A$(1)::END
1090 PRINT "COMPILATION OK!"
1900 RETURN
2000 DATA S,1
2010 DATA "FA440VA0VN15D2 VA2D3 VA4D4 VA6D5 VA8D6 VA12D7"
2020 DATA "VA14D8 VA15D0"
2030 DATA *
2040 DATA S,2
2050 DATA "FA220VA0VN15D2 VA2D3 VA4D4 VA6D5 VA8D6 VA12D7"
2060 DATA "VA14D8 VA15D0"
2070 DATA *
2080 DATA S,3
2090 DATA "FN5VN8VA15D1 VN6D1 VN4D1 VN6D1 VN8D2 VN12D2 VN15D0"
2100 DATA *
2110 DATA P,PLAY
2120 DATA "G2S G3H R /ZH =GZ =M1 CS1 ?=a NG NH IM La #<1"
2130 DATA "#M1GH &M0M #P2AB #P3CD L0 #I K0.1 ?<3 !=2 IA B1 L2"
2140 DATA "CK18 ?=x CK5 !=3 DA L1 (16.136A #L2AB L3 Sb K0.2"
2150 DATA "?<6 !=5 IC B4 L5 CK5 !=6 DC L4 (16.136C #L3CD L6"
2160 DATA "Sb B0 :b #P1EF (16.144E ?=8 NG #M1GH #L1EF &M0.3"
2170 DATA "L8 (24.224F !=x (32.216F ?=q ?>r =GA =M1 Bz Lr =GC"
2180 DATA "=M2 Lz -GE (-16.8G !=q +G4 +GG NG NH #M1GH #L1EF"
2190 DATA "&M0M Lq ; Lx #<0 =R1 CF124 ?>y IR Ly P4R"
2200 DATA *
2210 DATA *

Edited by moulinaie

Share this post


Link to post
Share on other sites

Oohh - this is making me think. I've got something I've wanted to really do in XB that hasn't been possible... Ohhh.... I gotta find a little time.

 

:)

Share this post


Link to post
Share on other sites

Super great !! it's a lot easier like this, especially to modify a program some months after !

 

i'm happy the MLC stil alive and progress ! ( i dream of CALL CHAR function, and more labels / variables avalaible )

Share this post


Link to post
Share on other sites

Super great !! it's a lot easier like this, especially to modify a program some months after !

 

i'm happy the MLC stil alive and progress ! ( i dream of CALL CHAR function, and more labels / variables avalaible )

Thanks.

Some ideas for now...:

1) more labels: since this new version, labels 0 to 9 are redifinable. So if you used label 0 and that all jumps to it are yet done, you can redefine label 0 later.

But take care of it... The new pseudo-instructions (NDO, FOR) use those labels (starting with L0). I think that label 9 should be always free because this would mean 9 loops nested!

2) more variables: arrays can be used to store large parts of data.

3) call char, yes, why not! the problem is that the string type is not supported by MLC... I'll have to work more... But using a byte array in VDP ram with the correct address of the character could give access to its definition.

 

4) When you'll have finished rewriting KABOOM, if you want I can add it to my pages (included or with a link).

 

Guillaume.

  • Like 1

Share this post


Link to post
Share on other sites

This BASIC/XB program is what I want my GPL Compiler to work on:

 

100 REM  *************	
110 REM  * ROBOCHASE *	
120 REM  *************	
130 REM  BY GREG VAUGHAN	 
140 REM  99'ER VERSION 2.13.1	  
150 REM  DISPLAY TITLE SCREEN 
160 RANDOMIZE
170 CALL SCREEN(16)
180 CALL CLEAR
190 DIM Z$(4)
200 DATA FFFFFFFFFFFFFFFF,0103070F1F3F7FFF,FF7F3F1F0F070301,80C0E0F0F8FCFEFF,FFFEFCF8F0E0C080
210 DATA FCFCFCFCFCFCFCFC,3F3F3F3F3F3F3F3F
220 DATA E0F0F8F0E0F0F8,F8F8D8D8D8F8F8,F0D8D8F0D8D8F0,78F0E0E0E0F078,8888D8F8D88888
230 DATA 2070D8D8F8D888,70D8C07018D870,F8F0E0F8E0F0F8
240 DATA FCFCCCCCCCCCFCFC,3838181818181818,FCFC0CFCFCC0FCFC,FCFC0CFCFC0CFCFC,CCCCCCFCFC0C0C0C
250 DATA FCFCC0FCFC0CFCFC,FCFCC0FCFCCCFCFC,FCFC0C0C0C0C0C0C,FCFCCCFCFCCCFCFC,FCFCCCFCFC0C0C0C
260 DATA 8040,2010,0804,0201
270 FOR X=33 TO 39
280 READ A$
290 CALL CHAR(X,A$)
300 NEXT X
310 FOR X=104 TO 111
320 READ A$
330 CALL CHAR(X,A$)
340 NEXT X
350 FOR X=48 TO 57
360 READ A$
370 CALL CHAR(X,A$)
380 NEXT X
390 READ A$,B$,C$,D$
400 Z$(1)=A$&B$&C$&D$
410 Z$(2)=D$&A$&B$&C$
420 Z$(3)=C$&D$&A$&B$
430 Z$(4)=B$&C$&D$&A$
440 CALL CHAR(97,Z$(1))
450 CALL CHAR(98,Z$(4))
460 CALL COLOR(9,9,16)
470 PRINT "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
480 A$=CHR$(34)
490 PRINT "a!$ !! !$ !! !% &' ";A$;"$ ";A$;"$ !%b"
500 PRINT "a!% &' !% &' !  !! &' !$ !$b"
510 PRINT "a!$ &' !$ &' !  !! !! #! !%b"
520 PRINT "a&' !! !% !! !$ &' %# #% !$b"
530 PRINT "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
540 PRINT: : : :"<PRESS ANY KEY TO CONTINUE>":"  <OR I FOR INSTRUCTIONS>": : : : :
550 X=3
560 Y=1
570 CALL COLOR(1,X,1)
580 CALL CHAR(97,Z$(Y))
590 CALL CHAR(98,Z$(5-Y))
600 CALL KEY(3,K,S)
610 IF S<>0 THEN 700
620 X=X+1
630 Y=Y+1
640 IF Y<5 THEN 660
650 Y=1
660 IF X<13 THEN 570
670 X=3
680 GOTO 570
690 REM  INITIALIZE VARIABLES	
700 R=10
710 D=1
720 S=0
730 LE=1
740 BA=24
750 DI=6
760 CALL CLEAR
770 CALL CHAR(126,"000008181C3C3E7E")
780 CALL CHAR(119,"81423C247E243CFF")
790 CALL CHAR(128,"00107C3838282800")
800 CALL CHAR(136,"38107C7C7C6C6C6C")
810 CALL CHAR(144,"007E7E7E7E7E7E00")
820 CALL CHAR(152,"10387CFE7C381")
830 CALL SCREEN(15)
840 CALL COLOR(1,2,1)
850 CALL COLOR(13,3,16)
860 CALL COLOR(14,5,15)
870 CALL COLOR(15,7,16)
880 CALL COLOR(16,16,15)
890 CALL COLOR(11,3,1)
900 DIM A(10)
910 DIM B(10)
920 IF K=73 THEN 3350
930 PRINT "	    hijiklmno"
940 PRINT "  !!!!!!!!!!!!!!!!!!!!!!"
950 FOR X=1 TO 20
960 PRINT "  !				    !"
970 NEXT X
980 PRINT "  !!!!!!!!!!!!!!!!!!!!!!"
990 FOR X=1 TO BA
1000 CALL HCHAR(INT(RND*20+3),INT(RND*20+6),144)
1010 NEXT X
1020 FOR X=1 TO DI
1030 CALL HCHAR(INT(RND*20+3),INT(RND*20+6),152)
1040 NEXT X
1050 FOR X=1 TO 10
1060 A(X)=INT(RND*20+6)
1070 B(X)=INT(RND*20+3)
1080 CALL GCHAR(B(X),A(X),CH)
1090 IF CH<>32 THEN 1060
1100 CALL HCHAR(B(X),A(X),136)
1110 NEXT X
1120 BU=0
1130 IF LE<4 THEN 1220
1140 BU=1
1150 NX=1
1160 NY=1
1170 BX=INT(RND*19+6)
1180 BY=INT(RND*19+3)
1190 CALL GCHAR(BY,BX,CH)
1200 IF CH<>32 THEN 1170
1210 CALL HCHAR(BY,BX,119)
1220 Q=INT(RND*20+6)
1230 W=INT(RND*20+3)
1240 CALL GCHAR(W,Q,CH)
1250 IF CH<>32 THEN 1220
1260 RT=0
1270 CALL HCHAR(1,29,48+D)
1280 GOSUB 2530
1290 CALL HCHAR(W,Q,32)
1300 REM   MOVE PERSON 
1310 CALL KEY(3,I,T)
1320 CALL KEY(1,X,Y)
1330 IF(X<>18)+(I=81)THEN 1360
1340 I=32
1350 GOTO 1420
1360 CALL JOYST(1,X,Y)
1370 IF(X=0)*(Y=0)THEN 1420
1380 IF X=4 THEN 1440
1390 IF X=-4 THEN 1470
1400 IF Y=4 THEN 1500
1410 IF Y=-4 THEN 1530
1420 IF(I=32)*(D>0)THEN 2370
1430 IF I<>47 THEN 1460
1440 Q=Q+1
1450 GOTO 1540
1460 IF I<>80 THEN 1490
1470 Q=Q-1
1480 GOTO 1540
1490 IF I<>81 THEN 1520
1500 W=W-1
1510 GOTO 1540
1520 IF I<>65 THEN 1540
1530 W=W+1
1540 CALL GCHAR(W,Q,CH)
1550 IF CH=136 THEN 2010
1560 IF CH=144 THEN 2050
1570 IF CH=152 THEN 2480
1580 IF CH=33 THEN 2050
1590 IF CH=126 THEN 1970
1600 IF CH=119 THEN 3180
1610 CALL HCHAR(W,Q,128)
1620 CALL SOUND(50,300,0,600,0,1200,0)
1630 REM  MOVE ROBOTS
1640 IF BU=1 THEN 3040
1650 FOR X=1 TO 10
1660 IF A(X)=0 THEN 1940
1670 CALL HCHAR(B(X),A(X),32)
1680 CH=.24+(LE*.03)
1690 IF CH<=.43 THEN 1710
1700 CH=.43
1710 IF RND>.5+(CH/2)THEN 1780
1720 IF A(X)=Q THEN 1780
1730 IF A(X)<Q THEN 1760
1740 A(X)=A(X)-1
1750 GOTO 1770
1760 A(X)=A(X)+1
1770 IF(RND>CH/(.5+(CH/2)))+(B(X)=W)THEN 1830
1780 IF B(X)=W THEN 1730
1790 IF B(X)<W THEN 1820
1800 B(X)=B(X)-1
1810 GOTO 1830
1820 B(X)=B(X)+1
1830 CALL GCHAR(B(X),A(X),CH)
1840 IF CH=128 THEN 2010
1850 IF(CH=136)*(LE<5)THEN 2920
1860 IF CH=32 THEN 1930
1870 A(X)=0
1880 S=S+25
1890 CALL SOUND(50,-5,0)
1900 R=R-1
1910 IF R=0 THEN 2100
1920 GOTO 1940
1930 CALL HCHAR(B(X),A(X),136)
1940 NEXT X
1950 GOTO 1290
1960 REM  DEATH MESSAGES
1970 GOSUB 2780
1980 CALL CLEAR
1990 PRINT "YOU RAN INTO A JUNK PILE":"ON LEVEL";LE: :
2000 GOTO 2660
2010 GOSUB 2780
2020 CALL CLEAR
2030 PRINT "YOU HAVE BEEN CAPTURED BY":"A ROBOT ON LEVEL";LE: :
2040 GOTO 2660
2050 GOSUB 2780
2060 CALL CLEAR
2070 PRINT "YOU HAVE BEEN ELECTRIFIED ":"ON LEVEL";LE: :
2080 GOTO 2660
2090 REM  GOING UP A LEVEL
2100 CALL COLOR(15,7,15)
2110 S=S+125
2120 FOR X=1 TO 5
2130 CALL SCREEN(7)
2140 CALL SOUND(-1000,110,0,220,0,400,0,-7,0)
2150 CALL SCREEN(15)
2160 CALL SOUND(-1000,300,0,600,0,800,0,-7,0)
2170 NEXT X
2180 CALL SOUND(-1,40000,30)
2190 R=10
2200 LE=LE+1
2210 IF BA<=12 THEN 2230
2220 BA=BA-4
2230 IF DI<=3 THEN 2250
2240 DI=DI-1
2250 D=INT(D/2)
2260 CALL HCHAR(1,29,48+D)
2270 GOSUB 2530
2280 CALL CLEAR
2290 CALL COLOR(15,7,16)
2300 PRINT "ENTERING LEVEL";LE: :
2310 PRINT "CURRENT SCORE:  ";S: : :
2320 FOR JJ=1 TO 1000
2330 NEXT JJ
2340 CALL CLEAR
2350 GOTO 930
2360 REM  TELEPORTING
2370 GOSUB 2530
2380 D=D-1
2390 S=S-50
2400 CALL HCHAR(1,29,48+D)
2410 CALL HCHAR(W,Q,32)
2420 Q=INT(RND*20+6)
2430 W=INT(RND*20+3)
2440 CALL GCHAR(W,Q,CH)
2450 IF CH<>32 THEN 2420
2460 GOSUB 2530
2470 GOTO 1290
2480 D=D+1
2490 CALL HCHAR(1,29,48+D)
2500 S=S+75
2510 CALL SOUND(50,-3,0,700,0)
2520 GOTO 1610
2530 CALL HCHAR(W,Q,128)
2540 FOR X=1 TO 5
2550 FOR Y=1 TO INT(RND*20+2)
2560 NEXT Y
2570 CALL COLOR(13,16,16)
2580 CALL SOUND(10,500,0)
2590 FOR Y=1 TO INT(RND*20+2)
2600 NEXT Y
2610 CALL COLOR(13,6,16)
2620 CALL SOUND(10,200,0)
2630 NEXT X
2640 RETURN
2650 REM  END OF GAME
2660 PRINT "YOUR SCORE IS ";S: :
2670 PRINT "PLAY AGAIN (Y/N)?"
2680 T=0
2690 CALL KEY(3,K,S)
2700 IF K=89 THEN 700
2710 IF K=78 THEN 2770
2720 T=T+1
2730 IF T<250 THEN 2690
2740 CALL CLEAR
2750 CALL SCREEN(16)
2760 GOTO 440
2770 END
2780 CALL HCHAR(W,Q,128)
2790 FOR X=1 TO 5
2800 FOR Y=1 TO 10
2810 NEXT Y
2820 CALL COLOR(13,16,7)
2830 CALL SOUND(-1000,110,0,120,0,130,0,-6,0)
2840 FOR Y=1 TO 20
2850 NEXT Y
2860 CALL COLOR(13,6,16)
2870 CALL SOUND(-1000,220,0,240,0,260,0,-7,0)
2880 NEXT X
2890 CALL SOUND(-8,40000,0)
2900 RETURN
2910 REM  ROBOT ROUTINES
2920 FOR Y=1 TO 10
2930 IF(A(X)=A(Y))*(B(X)=B(Y))*(X<>Y)THEN 2950
2940 NEXT Y
2950 S=S+50
2960 R=R-2
2970 A(Y)=0
2980 CALL HCHAR(B(X),A(X),32)
2990 IF LE>2 THEN 3010
3000 CALL HCHAR(B(X),A(X),126)
3010 A(X)=0
3020 CALL SOUND(300,300,0,-3,0)
3030 GOTO 1910
3040 CALL HCHAR(BY,BX,32)
3050 BX=BX+NX
3060 IF(BX<>25)*(BX<>6)THEN 3080
3070 NX=-NX
3080 BY=BY+NY
3090 IF(BY<>22)*(BY<>3)THEN 3110
3100 NY=-NY
3110 CALL GCHAR(BY,BX,CH)
3120 IF CH=32 THEN 3160
3130 IF CH=136 THEN 3270
3140 IF CH=128 THEN 3180
3150 CALL SOUND(200,440,0,880,0,523,0)
3160 CALL HCHAR(BY,BX,119)
3170 GOTO 1650
3180 S=S+100
3190 D=D+1
3200 CALL HCHAR(1,29,48+D)
3210 CALL HCHAR(W,Q,128)
3220 CALL SOUND(80,1397,0)
3230 CALL SOUND(80,1319,0)
3240 CALL SOUND(80,1397,0)
3250 BU=0
3260 GOTO 1650
3270 FOR X=1 TO 10
3280 IF(A(X)=BX)*(B(X)=BY)THEN 3300
3290 NEXT X
3300 A(X)=0
3310 R=R-1
3320 IF R=0 THEN 2100
3330 GOTO 3150
3340 REM  INSTRUCTIONS
3350 CALL CLEAR
3360 CALL SOUND(200,440,0,880,0,523,0)
3370 PRINT "	    hijiklmno"
3380 PRINT: : :
3390 PRINT " YOU HAVE BEEN IMPRISONED"
3400 PRINT:"IN A ROOM BY A MAD SCIENTIST": :"  YOU MUST AVOID THE BLUE": :"  ROBOTS AND CAUSE THEM TO"
3410 PRINT:"CRASH INTO THE RED BARRIERS.": : :
3420 GOSUB 3670
3430 PRINT "	    hijiklmno": : :
3440 PRINT "    ";CHR$(128);"-- YOU": :"    ";CHR$(136);"-- A ROBOT": :"    ";CHR$(144);"-- A BARRIER": :
3450 PRINT "    ";CHR$(152);"-- A TELEPORT RECHARGER": :"    w-- SPUNKY THE MARTIAN": :
3460 GOSUB 3670
3470 PRINT "	    hijiklmno": : :
3480 PRINT "    YOU CAN CONTROL YOUR": :"MOVEMENT BY THE KEYBOARD OR": :"	   THE JOYSTICK.": :
3490 PRINT "   Q - UP	  P - LEFT":"   A - DOWN    / - RIGHT": :
3500 PRINT " USE APPROPRIATE DIRECTIONS": :"	  ON THE JOYSTICK.": :
3510 GOSUB 3670
3520 PRINT "	    hijiklmno": : :
3530 PRINT "YOU CAN TELEPORT TO ANOTHER": :"   PLACE ON THE BOARD BY": :" PRESSING THE SPACE BAR OR": :
3540 PRINT "	  THE FIRE BUTTON": :"  HOWEVER, YOU ONLY HAVE A": :"CERTAIN NUMBER OF TELEPORTS,": :
3550 PRINT "INDICATED BY A NUMBER AT THE": :" TOP RIGHT HAND SIDE OF THE": :"		   SCREEN"
3560 GOSUB 3670
3570 PRINT "	    hijiklmno": : :
3580 PRINT "  YOU CAN GAIN ADDITIONAL": :" TELEPORTS BY RUNNING OVER": :"		 DIAMONDS": :
3590 PRINT "  GETTING SPUNKY WILL ALSO": :" GIVE YOU ANOTHER TELEPORT": :
3600 GOSUB 3670
3610 PRINT "	    hijiklmno": : :
3620 PRINT " EVERY TIME ALL TEN ROBOTS": :" ON A LEVEL DIE, YOU GO TO": :"	  THE NEXT LEVEL.": :
3630 PRINT "SPUNKY DOES NOT APPEAR UNTIL": :"	 THE FOURTH LEVEL.": : :"	  GOOD LUCK------": : :
3640 GOSUB 3670
3650 CALL CLEAR
3660 GOTO 930
3670 PRINT: :" <HIT ANY KEY TO CONTINUE>"
3680 CALL KEY(3,K,ST)
3690 IF ST=0 THEN 3680
3700 CALL CLEAR
3710 CALL SOUND(200,440,0,880,0,523,0)
3720 RETURN

 

This thing is so badly written for a compiler it almost looks like the ultimate challenge to one.

Share this post


Link to post
Share on other sites

@RXB that looks like it could go right into Wilhelm's, although the embedded math in the IF statements might fail.

Share this post


Link to post
Share on other sites

ROBOCHASE! Holy carp, I remember the local TIUG having scoring contests for this game. It was one of the first "99er" games I ever typed in, followed by (I believe it was called) "Archeodroid." Having that run in GPL would be pretty neat, but I wonder about the speed of the game.

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...