Notice. New forum software under development. It's going to miss a few functions and look a bit ugly for a while, but I'm working on it full time now as the old forum was too unstable. Couple days, all good. If you notice any issues, please contact me.
|
Forum Index : Microcontroller and PC projects : BASIC10Liners - challenge for CMM2
Page 3 of 4 | |||||
Author | Message | ||||
Paul_L Guru Joined: 03/03/2016 Location: United StatesPosts: 769 |
What I didn't mention is that each additional pair would increase the number of tokens in MMBasic by two. I don't think there are any more slots available! I think that a pre-processor, written in MMBasic, would probably work, but it would add steps (save prgram file, load preprocessor, run it pointing at the new program, load the preprocessed program) before running a program. The choices of what to include in the token list necessarily leaves a lot of nice gadgets out. Paul in NY |
||||
lizby Guru Joined: 17/05/2016 Location: United StatesPosts: 3015 |
Re vegipete's repair of my compressed version of ChemiChaos, Pete didn't mention that the up and down arrows weren't appearing (or at least, they didn't on my CMM2 when I finally got to it). That was fixed by changing the color with which they were drawn from the non-transparent black, RGB(1,1,1) to RGB(gray). mode 7,8:w=rgb(white):bk=rgb(gray):dim cr(5):cr(0)=rgb(green): cr(1)=rgb(red):cr(2)=rgb(cyan):cr(3)=rgb(yellow):cr(4)=rgb(blue) cls w:x=13:y=13:for i=0 to 4:circle x,y,12,,,cr(i),cr(i):y=y+26:next i line 13,134,13,154,2,bk:line 13,134,4,143,,bk:line 14,134,22,142,,bk line 13,160,13,180,2,bk:line 13,180,4,171,,bk:line 14,180,22,170,,bk line 30,2,72,2,2,bk:line 34,4,34,112,2,bk:line 67,4,67,112,2,bk: circle 51,112,17,,,bk:circle 51,112,16,,,bk:box 36,90,31,22,,w,w for i=1 to 9: on error skip: blit close i: next i r=w:x=0:y=0:w=26:For i=1 To 8:Blit read i,x,y,w,w:y=y+w:Next i Blit read 9,w+3,0,45,130: x=37:y=16:for i=1 to 4:blit write i,x,y:y=y+w:next i:v=5:b=4:CLS r: d$="ChemiChaos/5 Vials vegipete/lizby":text 160,0,d$,c,1,,rgb(red),r: d$="1=L,2=R;' '=pick/put,r=reload,x=next":text 160,10,d$,c,1,,rgb(red),r: For j=0 To 4:Blit write 9,j*50,100,0:next j:dim t(5,4):restore g: Do:d$="":For i=0 To 3:read l:h$=Str$(l):d$=d$+h$:if l=0 then:cls r:font 5: s$="S A F E !":text 60,100,s$,,,,rgb(green),r:do:loop:endif:next i: e: k=1:x=10:For i=0 To 3:h$=mid$(d$,i*4+1,4):for j=1 to b: c$=mid$(h$,j,1):l=val(c$):t(k,j)=l:t(5,j)=0:blit write l,i*50+10,82+j*w next j:k=k+1:Next i:blit write 6,9,70:p=1:u=0:do:do:c$=inkey$: loop until c$<>"":if c$="1" then:if x>50 then: blit x,44,x-50,44,26,52: box x,44,26,52,0,r,r:x=x-50:p=p-1:endif:elseif c$="2" then: if x<200 then: blit x,44,x+50,44,26,52:box x,44,26,52,0,r,r:x=x+50:p=p+1:endif elseif c$="r" then:box 0,44,320,52,,r,r:box 210,108,w,w*4,0,r,r:goto e: elseif c$="x" then:box 0,44,320,w*2,0,r,r:box 210,108,w,w*4,0,r,r: exit : elseif c$=" " then:if u then:for i=1 to b:n=t(p,i):if n>0 then:exit for:endif: next i:if n=z or i=5 then:i=i-1: if i>0 then:t(p,i)=z:blit write z,x,82+i*w blit write 8,x,44: blit write 6,x,70:u=0:endif:endif:else:for i=1 to b: z=t(p,i):if z<>0 then:t(p,i)=0:x=(p-1)*50+10:blit write z,x,44: blit write 7,x,70:blit write 8,x,82+i*w:u=1:exit for:endif:next i:endif: endif:loop:loop: g: Data 2321,1412,4412,4333,4232,5235,2443,3554,3124,2121,2444,3331,1224,4232 Data 4311,4133,2141,4333,3242,4121,1314,3424,3231,2142,3233,4141,1241,2243 Data 3324,4421,1123,2431,4552,2444,3255,3332,2422,1434,3313,1241,0 I don't understand why I could see the arrows drawn with rgb(1,1,1), could BLIT READ and then BLIT WRITE them, but after CLS(white), BLIT WRITE didn't show them. This above, though, works for me, and is easier than having to guess where the arrow is for picking a ball. PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
vegipete Guru Joined: 29/01/2013 Location: CanadaPosts: 1082 |
That's why I wrote: Visit Vegipete's *Mite Library for cool programs. |
||||
lizby Guru Joined: 17/05/2016 Location: United StatesPosts: 3015 |
Ah, thanks. I'm a version behind on the manual, and that parameter isn't shown. Updated now. "Default value is 4": &B100 = don't copy transparent pixels So 0 is "do copy transparent pixels". I'm still not sure I fully understand. If I did BLIT WRITE 6,x,y on the screen from which I did the BLIT READ 6, everything looked good even without transparency disabled. But after a CLS RGB(white), BLIT WRITE 6 showed nothing. And I had thought that with RGB(1,1,1) instead of RBG(black) I was avoiding the transparency issue. But RGB(gray) works, and looks to me to be close enough to black (and the color doesn't really matter as long as the arrows appear). PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
vegipete Guru Joined: 29/01/2013 Location: CanadaPosts: 1082 |
Yes, I often struggle with 'black' too. Black is considered transparent. Trouble is, if we specify RGB(1,1,1), the firmware has to translate that to one of the available colours - and it picks ... BLACK ... as the closest one. I wish we could specify palette number to draw with. Then we could map a particular colour number other than zero to RGB(0,0,0) and then draw with that colour number when we want a solid black, and not with the default one. Adds to the fun! I think in the case of the arrows and test tubes, when you BLIT from the white source, the black pixels allow the white background to show through, resulting in nothing displayed. Test with different RGB(x,x,x) to find the darkest that works. Maybe RGB(20,20,20)? Maybe RGB(10,10,10)? Visit Vegipete's *Mite Library for cool programs. |
||||
jirsoft Guru Joined: 18/09/2020 Location: Czech RepublicPosts: 532 |
And the RGB(NOTBLACK) isn't working for you? I'm using it almost everywhere... Jiri Napoleon Commander and SimplEd for CMM2 (GitHub), CMM2.fun |
||||
Turbo46 Guru Joined: 24/12/2017 Location: AustraliaPosts: 1593 |
vegipete, Is it possible that you could post an uncompressed version of your "In Defense of the Green Hills of Earth" program? I'd like to be able to understand it and perhaps modify it. Bill PS maybe that should have been a stipulation of the contest. Keep safe. Live long and prosper. |
||||
thwill Guru Joined: 16/09/2019 Location: United KingdomPosts: 3840 |
It was a consideration Bill and their are points for clarity, but ultimately we wanted to reduce the barriers to entry. I'm sure that most authors will happily clean up their code if interest is expressed, if not then I don't mind looking at doing so myself. Best wishes, Tom Game*Mite, CMM2 Welcome Tape, Creaky old text adventures |
||||
Turbo46 Guru Joined: 24/12/2017 Location: AustraliaPosts: 1593 |
Hi Tom, I did try to re-format the program and ended up with over 200 lines. But failed. It didn't work properly. I would have thought that someone would start out with a readable program and continually whittle it down to something incomprehensible and the original version would still be available. Never mind. Bill Keep safe. Live long and prosper. |
||||
vegipete Guru Joined: 29/01/2013 Location: CanadaPosts: 1082 |
You are assuming there was an uncompressed version of "In Defense of the Green Hills of Earth". The first half was written right from the start at 50-75% compressed, to test if it was remotely possible. There was even a major internal re-write, changing the alien formation from 2 arrays of strings to arrays of relative x and y coordinates. (I was quite surprised when the rewrite worked perfectly first time.) The rest of the program was embellishments, added as space allowed. A new routine may have been written mostly expanded, then squashed mercilessly. Sometimes preexisting sections were expanded somewhat to slide in new functionality, or modified. However, I will post a properly formatted version, with comments and all. Might be a day or two... Visit Vegipete's *Mite Library for cool programs. |
||||
lizby Guru Joined: 17/05/2016 Location: United StatesPosts: 3015 |
Sorry to be late replying. Yes, RGB(NOTBLACK) does work. (I had forgotten about that, but mistakenly thought that RGB(1,1,1) would handle the issue, not thinking through the vagaries of what it might mean in different modes.) Idle musing: what manner of beast is NOTBLACK? It isn't a variable, because you can't set it. It isn't quite a constant because its value depends on the mode. Is it a "variable" constant? Or a pseudo-constant? Similar to but not the same as mm.FontHeight. PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
jirsoft Guru Joined: 18/09/2020 Location: Czech RepublicPosts: 532 |
I think RGB(NOTBLACK) is simply wired into MMBasic, same-way as other color constants. And it simply choses for current MODE color with most black but not BLACK and no transparency (for me mostly &hF002000). But Peter can answer it better... Jiri Napoleon Commander and SimplEd for CMM2 (GitHub), CMM2.fun |
||||
Volhout Guru Joined: 05/03/2018 Location: NetherlandsPosts: 3527 |
OK here is my entry for the BASIC 10 liners. I simply loved this challenge. And since I use a CMM1 I cannot really compete with the 100x48 challenge on CMM2. A CMM1 basic is simply cannot match up to CMM2 basic. My entry: TLS = Ten Line Sokoban It runs on a CMM1 on MMBasic V4.5c. MMBasic on the CMM1 is much older than the current 5.0x versions running on CMM2 and micromites. And it has some very strange limitations. 1/ Although DO can be anywhere on a multi statement line, LOOP must be at the beginning of a line. 2/ Same for FOR and NEXT 3/ There is no RESTORE nn (restore data read pointer to a certain location) 4/ There is no MIN/MAX 5/ No select/case Originally I wanted to put TETRIS in 10 lines, but that simply would not fit (not with my programming capabilities). Hence Sokoban. Sokoban is a game where a warehouse guy (yellow circle) has to push boxes (green blocks) from their current location to the destination (blue field).Once he completes the task, you get a new level. Pushing the "r" (lower case) will let you redo the game. Here is the Sokoban game in 10 lines s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$) For j=1To s:w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w:If f(i,j)<2Then t(i,j)=f(i,j) Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:If a$="r"Then:Restore:Exit Do:EndIf:d=1 For i=1To s:For j=1To s:k=f(i,j):If k=1Then:d=0:EndIf:o=120+z*(i-6):p=100+z*(j-6) Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf Next j,i:If d=1Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$) If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:f=y+c:If f(e,f)=2Then If f(e+b,f+c)=<1Then:f(e,f)=0+t(e,f):f(e+b,f+c)=2:Else:b=0:c=0:EndIf ElseIf f(e,f)=3Then:b=0:c=0:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4 Loop:Loop:Data 2,2,FFFF,D5F3,CBC3,C023,C3CF,EC0F,C0FF,FFFF,0,0,0,0,0 For those who want to understand what the above does, here is some explanation of all these single character variables. ' TLS = ten line sokoban ' control by cursor keys-128 (128,129,130,131 => 0,1,2,3 => ^ V < >) ' playfield values 0=empty, 1=target, 2=block, 3=wall 'z = size block 'x,y = position human 'e,f = new position human 'o,p = position onscreen 'n = ascii value key 'b,c = direction human 'd = done 'a$ = key pressed 'w = dummy 'l,m = vars for decoding rooms 'i,j = counters 'k = value field (i,j) 'f() = playing field 't() = target locations for the boxes 's = size playfield (sxs) When you look at the code, you see that s=13, meaning you can have a playfield that are 13x13 in size. I took the included level and additional levels from internet, and translated them into hexadecimal numbers using above legend and 2 bits for each cell Here are some additional levels: First 2 fields are start location guy (x,y), then the playfield If your playfield is smaller, simply add 0's until you have 13. '--------------extra data------------- 'simple 8x8 'Data 2,2,FFFF,D003,FF03,C003,C083,C003,C003,FFFF,0,0,0,0,0 '8x8 field Data 5,2,FF0,C3F,FC03,C273,CE23,C44F,FF0C,3FC,0,0,0,0,0 Data 2,2,FFFF,C303,C0B3,DA13,CDEF,C10C,FFFC,0,0,0,0 '11x11 field Data 2,3,FFC,3FC0C,30C8C,300BF,37F23,37203,3703F,37230,37F30,30030,3FFF0,0,0 Happy sokobanning.... Volhout P.S. due to the lack of "RESTORE nn" when you restart one of the added levels, you restart to level 1 Edited 2021-03-08 01:33 by Volhout PicomiteVGA PETSCII ROBOTS |
||||
vegipete Guru Joined: 29/01/2013 Location: CanadaPosts: 1082 |
Ten Line Sokoban. Nice. I had to fire up my original Colour Maximite to give it a test. Wow! That's pretty awesome! I wrote a Sokoban clone for the CMM2 a while back and it took me considerably more than 10 lines to do it, so I had to see what cool tricks you used. Your legal move evaluator algorithm is way more elegant than mine. I have discovered thought that I can cheat and stand on the last target instead of pushing the last block in to place. Visit Vegipete's *Mite Library for cool programs. |
||||
TassyJim Guru Joined: 07/08/2011 Location: AustraliaPosts: 5903 |
I simply loved this challenge. And since I use a CMM1 I cannot really compete with the 100x48 challenge on CMM2. A CMM1 basic is simply cannot match up to CMM2 basic. My entry: TLS = Ten Line Sokoban The only change I had to make to the program to run it on a CMM2 was add OPTION LEGACY ON to the beginning and change variable f to g You can not have a simple variable with the same name as an array. I think you should be allowed the extra line for OPTION LEGACY ON OPTION LEGACY ON s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$) For j=1To s:w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w:If f(i,j)<2Then t(i,j)=f(i,j) Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:If a$="r"Then:Restore:Exit Do:EndIf:d=1 For i=1To s:For j=1To s:k=f(i,j):If k=1Then:d=0:EndIf:o=120+z*(i-6):p=100+z*(j-6) Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf Next j,i:If d=1Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$) If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:g=y+c:If f(e,g)=2Then If f(e+b,g+c)=<1Then:f(e,g)=0+t(e,g):f(e+b,g+c)=2:Else:b=0:c=0:EndIf ElseIf f(e,g)=3Then:b=0:c=0:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4 Loop:Loop:Data 2,2,FFFF,D5F3,CBC3,C023,C3CF,EC0F,C0FF,FFFF,0,0,0,0,0 I did expand the program into something readable to find the same name bug but it does run in the compressed mode. Jim VK7JH MMedit MMBasic Help |
||||
Volhout Guru Joined: 05/03/2018 Location: NetherlandsPosts: 3527 |
Good find, I missed that one. OPTION LEGACY ON to the beginning and change variable f to g You can not have a simple variable with the same name as an array. I knew about the limitation for CMM2, and thought I fixed them all, but missed the double use of f as variable and as array. Thank you for reviewing. I really appreciate you took the time to play with this baby, since it took quite some time to make. This is a very good reward !! I'll see if I can fix vegipete's cheat within the 10 lines. There is still room.... I even saw I can remove 2 more characters. Edited 2021-03-08 18:28 by Volhout PicomiteVGA PETSCII ROBOTS |
||||
vegipete Guru Joined: 29/01/2013 Location: CanadaPosts: 1082 |
The following should give you a bunch more space: A section of the code now is: (expanded) d = 1 ' Draw the playfield For i = 1 To s For j = 1 To s k = f(i,j) ' playfield values 0=empty, 1=target, 2=block, 3=wall If k = 1 Then d = 0 EndIf o = 120+z*(i-6) p = 100+z*(j-6) Line(o,p)-(o+z-2,p+z-2),3 And k,BF If k = 4 Then Circle(o+z/2-1,p+z/2-1),3,6,,F EndIf Next j,i If d = 1 Then ' done if no target cells visible Exit Do EndIf I think this can be changed to: d = 0 <######## change this line> ' Draw the playfield For i = 1 To s For j = 1 To s k = f(i,j) ' playfield values 0=empty, 1=target, 2=block, 3=wall 'If k = 1 Then <######## change these > ' d = 0 <######## three lines > 'EndIf <######## to the following> d = d+(k=1) o = 120+z*(i-6) p = 100+z*(j-6) Line(o,p)-(o+z-2,p+z-2),3 And k,BF If k = 4 Then Circle(o+z/2-1,p+z/2-1),3,6,,F EndIf Next j,i If d=0 Then ' done if no target cells visible <######## change Exit Do EndIf However, this is deep in the heart of the end-of-level detection, so some extra logic will be required. The following checks if player is standing on an empty cell and seems to work: If d=0 and (t(x,y)=0) Then ' done if no target cells visible <######## change Visit Vegipete's *Mite Library for cool programs. |
||||
Volhout Guru Joined: 05/03/2018 Location: NetherlandsPosts: 3527 |
Wauw Vegipete, Never knew that worked, the a=(b=1) boolean function. I used it immediately in several locations. I also fixed the human on target bug And another bug where a target on level 1 would copy over to level 2 if it was precise under a box. I copied TassyJims fix that prevents double use of the f variable. So here is the new code (for CMM2 users OPTION LEGACY ON first) s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$) For j=1To s:w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w:t(i,j)=(f(i,j)=1) Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:d=0:If a$="r"Then:Restore:Exit Do:EndIf For i=1To s:For j=1To s:k=f(i,j):d=d+(k=1):o=120+z*(i-6):p=99+z*(j-6) Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf Next j,i:If d+q=0Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$) If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:g=y+c:If f(e,g)=3Then:b=0:c=0 ElseIf f(e,g)=2Then:If f(e+b,g+c)<2Then:f(e,g)=t(e,g):f(e+b,g+c)=2:Else:b=0:c=0 EndIf:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4:q=t(x,y) Loop:Loop:Data 2,2,FFFF,D5F3,CBC3,C023,C3CF,EC0F,C0FF,FFFF,0,0,0,0,0 If it where not for the LOOP and NEXT that need to be at beginning of a line, I would even be able to add a whole level in 10 lines... Thank you for all your help, I (again) learned a lot. Happy Sokobanning PicomiteVGA PETSCII ROBOTS |
||||
TassyJim Guru Joined: 07/08/2011 Location: AustraliaPosts: 5903 |
Make 2 changes. Line 5 you are missing then ':' after THEN Line 6 remove the first 'DO' so you just have 'EXIT' instead of 'EXIT DO'. In this case, you can get away with it but not something that will always work. (Not sure if it is the same on the CMM1) Jim VK7JH MMedit MMBasic Help |
||||
vegipete Guru Joined: 29/01/2013 Location: CanadaPosts: 1082 |
What an awesome 10 lines of program! If you change the level decoding from (in line 2) w=2^((j-1)*2):m=3*w:f(i,j)=(l And m)/w tof(i,j)=l And 3:l=l\4 you can gain enough space to add data for a second level: s=13:Dim f(s,s),t(s,s):Do:Mode 4:z=9:Read x,y:For i=1To s:Read a$:l=Val("&h"+a$) For j=1To s:f(i,j)=l And 3:l=l\4:t(i,j)=(f(i,j)=1):Data 2,2,FFFF,D5F3,CBC3,C023 Next j,i:Print @(99,10)"TLS":f(x,y)=4:Do:d=0:If a$="r"Then:Restore:Exit Do:EndIf For i=1To s:For j=1To s:k=f(i,j):d=d+(k=1):o=120+z*(i-6):p=99+z*(j-6):Data C3CF Line(o,p)-(o+z-2,p+z-2),3And k,BF:If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf Next j,i:If d+q=0Then:Exit Do:EndIf:Do:a$=Inkey$:Loop While a$="":n=3And Asc(a$) If n<2Then:b=0:c=n*2-1:Else:b=n*2-5:c=0:EndIf:e=x+b:g=y+c:If f(e,g)=3Then:b=0:c=0 ElseIf f(e,g)=2Then:If f(e+b,g+c)<2Then:f(e,g)=t(e,g):f(e+b,g+c)=2:Else:b=0:c=0 EndIf:EndIf:f(x,y)=t(x,y):x=x+b:y=y+c:f(x,y)=4:q=t(x,y):Data EC0F,C0FF,FFFF,0,0 Loop:Loop:Data 0,0,0,5,2,FF0,C3F,FC03,C273,CE23,C44F,FF0C,3FC,0,0,0,0,0 Jamming data statements in the little gaps at the ends of lines works great. Some might object to lines 5 and 7 being 1 character too long. You could fix line 5 by changing If k=4Then Circle(o+z/2-1,p+z/2-1),3,6,,F:EndIf toCircle(o+z/2-1,p+z/2-1),3*(k=4),6,,F Visit Vegipete's *Mite Library for cool programs. |
||||
Page 3 of 4 |
Print this page |