moulinaie Posted October 26, 2011 Share Posted October 26, 2011 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) Quote Link to comment Share on other sites More sharing options...
+retroclouds Posted October 26, 2011 Share Posted October 26, 2011 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 Quote Link to comment Share on other sites More sharing options...
moulinaie Posted October 26, 2011 Author Share Posted October 26, 2011 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. Quote Link to comment Share on other sites More sharing options...
unhuman Posted October 26, 2011 Share Posted October 26, 2011 This rocks! Quote Link to comment Share on other sites More sharing options...
moulinaie Posted October 27, 2011 Author Share Posted October 27, 2011 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!! Quote Link to comment Share on other sites More sharing options...
+retroclouds Posted October 28, 2011 Share Posted October 28, 2011 (edited) 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 October 28, 2011 by retroclouds Quote Link to comment Share on other sites More sharing options...
moulinaie Posted October 29, 2011 Author Share Posted October 29, 2011 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. Quote Link to comment Share on other sites More sharing options...
+retroclouds Posted October 29, 2011 Share Posted October 29, 2011 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 ] Quote Link to comment Share on other sites More sharing options...
moulinaie Posted October 29, 2011 Author Share Posted October 29, 2011 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 guillaume.tello@orange.fr 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 Quote Link to comment Share on other sites More sharing options...
moulinaie Posted October 29, 2011 Author Share Posted October 29, 2011 (edited) 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 October 29, 2011 by moulinaie Quote Link to comment Share on other sites More sharing options...
unhuman Posted October 29, 2011 Share Posted October 29, 2011 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. Quote Link to comment Share on other sites More sharing options...
rocky007 Posted October 30, 2011 Share Posted October 30, 2011 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 ) Quote Link to comment Share on other sites More sharing options...
moulinaie Posted October 30, 2011 Author Share Posted October 30, 2011 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. 1 Quote Link to comment Share on other sites More sharing options...
+RXB Posted October 30, 2011 Share Posted October 30, 2011 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. Quote Link to comment Share on other sites More sharing options...
unhuman Posted October 31, 2011 Share Posted October 31, 2011 @RXB that looks like it could go right into Wilhelm's, although the embedded math in the IF statements might fail. Quote Link to comment Share on other sites More sharing options...
+OLD CS1 Posted October 31, 2011 Share Posted October 31, 2011 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. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.