![]() |
Forum Index : Microcontroller and PC projects : An attempt to port ChemiChaos to the Armmite F4.
Author | Message | ||||
lizby Guru ![]() Joined: 17/05/2016 Location: United StatesPosts: 3309 |
I thought it might be fun to try to port vegipete's excellent ChemiChaos to the Armmite F4 (which, to my mind, remains the best and least expensive of the all-in-one ports of MMBasic (though lacking in the graphics capabilities of the CMM2)). For those not familiar, the F4 is based on a STM32F407VET6 board , includes USB programming, an RTC, a micro SD socket, a winbond flash chip, and a high-speed, 16-bit LCD interface. Board and LCD can be had for around $25US. Larger LCDs up to 7 or even 9 inches are possible. I've never written a game, and prior to CMM2 had not played one since arcade Pac-Man and Space Invaders on a Xerox Alto/Bravo in the early 80s. So it would be a learning experience. I downsized Pete's "ChemiChaosSprites.png" file to a 320 pixel width, keeping the aspect ratio, and turned it into a bmp file. Downloaded with XMODEM RECEIVE and then LOAD IMAGE "ChemiChaosSprites320b.bmp". So far, so good. ![]() I cleared some space on that image and did some BLITs: box 180,0,140,240,0,rgb(black),rgb(black) blit 27,0,250,0,46,120 blit 0,0,259,10,26,26: blit 0,26,259,36,26,26: blit 0,104,259,62,26,26: blit 0,156,259,88,26,26 Again excellant. ![]() There is no F4 manual, so documentation of the commands chain back to the Armmite H7 manual, the Micromite Plus, and the original Micromite manual. The H7 says "The BLIT and SPRITE commands can be used interchangeably. All Micromite Plus functionality is preserved with minor functional changes." However, for the F4, SPRITE 27,0,250,0,46,120 yields "Error: Unknown command", so BLIT it is, and as far as I can tell, only the Micromite Plus commands. BLIT READ #1,0,0,26,26: BLIT READ #2,0,26,26,26: BLIT READ #3,0,52,26,26: BLIT READ #4,0,78,26,26 The above works to save 26x26-pixel bit areas into 4 numbered buffers (sprites?!). It turns out because of the resizing, some of the balls are 26 pixels high and some are 25. After fiddling, I am able to make 9 BLIT buffers (7 balls, one arrow, one test tube. Then I can produce this: ![]() Here's the code. Dim integer lx%,ly%, li%,lj%,lK% Load IMAGE "ChemiChaosSprites320b.bmp" On error skip Blit CLOSE #1:Blit CLOSE #2:Blit CLOSE #3:Blit CLOSE #4:Blit CLOSE #5 Blit CLOSE #6:Blit CLOSE #7:Blit CLOSE #8:Blit CLOSE #9 Blit READ #1,0,0,26,26: Blit READ #2,0,25,26,26: Blit READ #3,0,51,26,26 Blit READ #4,0,76,26,26: Blit READ #5,0,102,26,26 Blit READ #6,0,127,26,26: Blit READ #7,0,152,26,26 Blit READ #8,26,126,26,26 Blit READ #9,27,0,46,120 CLS RGB(white) ly%=100: lx%=20 For li%=1 To 6 Blit WRITE #9,lx%,ly%,46,120 Blit WRITE li%,lx%+9,ly%+90,26,26 lx%=lx%+46 Next li% lx%=29 For li%=1 To 6 ly%=110 For lj%=1 To 3 lk%=Rnd()*6+1 Blit WRITE lk%,lx%,ly%,26,26 ly%=ly%+26 Next lj% lx%=lx%+46 Next li% Blit WRITE #8,75,70,26,26 Do : Loop The images aren't perfect, but should be good enough so that I can try to start in on Pete's game code. I still need to produce a down arrow (probably on the PC), since I can't see that there is a way to rotate the BLIT buffer. PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
RetroJoe![]() Senior Member ![]() Joined: 06/08/2020 Location: CanadaPosts: 290 |
Wow! Tres cool !! Enjoy Every Sandwich / Joe P. |
||||
lizby Guru ![]() Joined: 17/05/2016 Location: United StatesPosts: 3309 |
Success. ChemiChaos on youtube. My porting method was brute force. After setting up the 12 sprites (blit buffers) and changing the text to be output with the TEXT command, I simply ran the program on the F4 until it crashed, usually at a BLIT command with invalid parameters or a SPRITE command. I then fixed that and ran until the next "Invalid syntax". I made most changes on the PC and did "XMODEM R "ccf4.bas", but if the change was simple (a value or a statement or two) I used the MMBasic editor (and also made the change on the PC). I probably used XMODEM R 50 times or more. I tried to make it so it would run on either the CMM2 or Armmite F4. I set up a variable, cputype%, initialized it to 0 for CMM2, and checked for mm.device$="ARMmite F407" to set it to 4. Then at each necessary point, I checked cputype% and executed either CMM2 or F4 code. I have not yet gone back to see if the code works on the CMM2. As I expected, except for the graphics parts, vegipete's game code just worked. They may be some exceptions I haven't tested yet. The bottoms of the balls (black) are transparent on the CMM2. I saw some suggestion that transparency might work on some LCDs, but didn't investigate when it didn't on this 320x240 model. I didn't make allowance for the 480x272 or 800x600 LCDs which can be fitted (with an adaptor) to the F4--I just plugged in magic numbers for the 320x240. I may fix that later. Code is attached, along with the ChemiChaos320b.bmp file. Thanks, Pete, for the fine and fun code example. ChemiChaosF4.zip PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
lizby Guru ![]() Joined: 17/05/2016 Location: United StatesPosts: 3309 |
Playing through to the end revealed a few more bugs. I shifted the vials left, but the 7th one shows up distorted. The balls appear correctly, though. For the games which have an 8th and 9th vial, they are off the edge of the screen, but the program handles them properly and you can complete the round. Among the non-graphics things I had to change because the CMM2 commands are not supported by the F4 were MATH SCALE and MOD$ on the left of the "=" sign. ChemiChaosF4.zip PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
Chopperp![]() Guru ![]() Joined: 03/01/2018 Location: AustraliaPosts: 1090 |
FYI ChemiChaos screen grab on an F4 with 7" display stuck at Level 6.7 Only taking up about half the screen at this stage. More work to be done. This would not be compatible with the CMM2 without further changes. Just playing at this stage. I didn't try to resize any of the graphics. A number of changes done to lizby's great effort to get to this stage. The Keystrokes table was off screen & had to be moved up. It then got partially erased in use after "Safe" came up & a key hit. I could not work out why so I eventually modified the ShowCounts & ToggleCounts routines to refresh the table & still make it selectable On/Off. The Level indicator was changed to a fixed text & relocated as the original moved down the screen if the "R" key was pressed. Not sure where the spurious down arrow came from. Thanks again vegipete for the great game. ![]() Brian ChopperP |
||||
lizby Guru ![]() Joined: 17/05/2016 Location: United StatesPosts: 3309 |
Chopperp--good work carrying on. As you saw, I didn't implement any display of the statistics. That round you're showing is the most difficult one. It took me 6 or 7 retries to solve it. PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
vegipete![]() Guru ![]() Joined: 29/01/2013 Location: CanadaPosts: 1121 |
Nice work you guys! I'm glad my program is providing you with entertainment, and is written cleanly enough that you can figure out how to attack it and modify it and bend it to your will. Awesome! Visit Vegipete's *Mite Library for cool programs. |
||||
lizby Guru ![]() Joined: 17/05/2016 Location: United StatesPosts: 3309 |
ChemiChaos on the F4 with the IPS/OTM8009A 800x489 LCD. Couldn't use the code posted above because the F4 does not have enough memory to BLIT WRITE all the balls and other graphics, so the balls are just filled circles: ![]() F4 on Fruit of the Shed 'OPTION EXPLICIT ' all variables must be defined before use - HAH! Bite me. ' ' ChemiChaos ' by vegipete, December 2020 ' ' required support files (place in same directory): ' ChemiChaosSprites.png ' ChemiChaosSprites.png ' CCRedHand.spr ' ' Sort the Chemical Balls in the Test Tubes ' Move with the arrow keys ' Pick and place with the space bar ' Restart level with R (upper or lower case for letter commands) ' Toggle stats with C ' Quit with Esc ' Replace picked up ball with Z (undocumented) ' ' v 1.2 Mouse improvements, more levels, key press & mouse click counting ' v 1.1 Mouse control, change to level numbering ' v 1.0 Original release, graphics tweaks, more levels + counter, intro text ' v < development ' '=========================================== 'option console screen dim cputype%=0, f4%=4, cmm2%=0, ls$, ipsFlag%=0 if MM.Device$="ARMmite F407" then cputype%=f4% if cputype%=f4% then ' armmite F4 dim integer clr(9) clr(0)=rgb(red): clr(1)=rgb(green): clr(2)=rgb(blue): clr(3)=rgb(Yellow) clr(4)=rgb(cyan): clr(5)=rgb(magenta): clr(6)=rgb(brown): clr(7)=rgb(white) clr(8)=rgb(gray): clr(9)=rgb(black) dim integer i,j,k,l,xm,n,x,y,x2,y2,x3,y3 dim integer cR=0,cG=1,cB=2,cY=3,cC=4,cM=5,cO=6,cW=7,cGR=8,cBK=9 dim integer BLK=clr(cBK) dim integer ballRad=33 const UPARROW=1,DOWNARROW=0 cls F4_setup ' establish 12 sprites (blit buffers #1-12) else ' CMM2 mode 1,16 ' more colours for better ball shading endif dim keypress dim fname$ dim levelnum dim movingball dim vials(9,4) ' 9 vials, each can hold 4 balls dim vialsbak(9,4) ' 9 vials, restore copy dim ballcols(6) = (0,1,2,3,4,5,6) ' allow shuffling of ball colours dim m$,a$ dim integer movecount(8) dim countvisible = 0 if cputype%=cmm2% then ' CMM2 sp = 1 ' sprite page page write sp : cls load png "ChemiChaosSprites.png" sprite read 1,36,180,36,36,sp ' up arrow open "CCRedHand.spr" for random as #1 seek #1, 324 movecount(7) = val(input$(12,#1)) seek #1, 342 movecount(8) = val(input$(12,#1)) close #1 gui cursor load "CCRedHand.spr" mport = mm.info(option mouse) + 1 if mport then controller mouse open mport-1, LeftClick gui cursor on 2 settick 50, PeriodInt ' periodic interrupt to move mouse pointer else ' no mouse set so try find one mport = 4 do on error skip controller mouse open mport-1, LeftClick if MM.ERRNO then mport = mport - 1 else gui cursor on 2 settick 50, PeriodInt ' periodic interrupt to move mouse pointer exit do endif loop until mport = 0 ' no mouse found anywhere endif pause 1000 ' screen sync time page write 0 : cls rgb(white) endif levels = 1 levelnum = 0 levelball = 0 restore gamelevels ShuffleBCols xpos = 1 gameover = 0 handx = MM.HRES/2 handy = MM.VRES/2 newclick = 0 charx = 245 : chary = 10 if mport then gui cursor hide PutString("CHEMICAL CHAOS") if cputype%=CMM2% then line 240,37,545,37,4,0 text 565,20,"v1.2 by vegipete, Jan 2021","LT",1,1,0,rgb(white) else if ipsFlag% then: font 4: else: font 2: endif ls$="v1.3 by vegipete, Jan 2021 (F4 by lizby)" ly%=mm.fontheight+2 lx%=mm.hres/2 - len(ls$)/2*mm.fontwidth text lx%,ly%,ls$,,,,,rgb(black),rgb(white) ly%=ly%+mm.fontheight+2 putstring("") endif charx = 0 : chary = 50 ' 12345678901234567890123456789012345678 PutString("There is chaos and confusion all") charx = 0 : chary = chary + 30 PutString("through the chemistry lab! The") charx = 0 : chary = chary + 30 PutString("chemicals have been mixed. Your task") charx = 0 : chary = chary + 30 PutString("is to combat the chaos and restore") charx = 0 : chary = chary + 30 PutString("order by sorting the chemicals.") charx = 0 : chary = chary + 30 PutString("Move the coloured balls one by one") charx = 0 : chary = chary + 30 PutString("until each test tube contains a single") charx = 0 : chary = chary + 30 PutString("colour. However, you can not drop a") charx = 0 : chary = chary + 30 PutString("ball on a different coloured one!") charx = 0 : chary = chary + 30 PutString("Use the arrow keys to move. Select and") charx = 0 : chary = chary + 30 PutString("drop with the space bar. Press R to") charx = 0 : chary = chary + 30 PutString("restart if you get stuck.") charx = 0 : chary = chary + 55 PutString("Press Esc to quit and call HazMat.") text 30,470,"Press 'C' to toggle stats.","LT",4,1,0,-1 ' add some colour to the info screen if cputype%=CMM2% then blit 0,0*36, 20,560,36,36,sp,4 ' coloured ball blit 0,1*36,175, 10,36,36,sp,4 ' coloured ball blit 0,2*36,685, 70,36,36,sp,4 ' coloured ball blit 0,3*36,750,185,36,36,sp,4 ' coloured ball blit 0,4*36, 70,405,36,36,sp,4 ' coloured ball blit 0,5*36,540,380,36,36,sp,4 ' coloured ball blit 0,6*36,620,500,36,36,sp,4 ' coloured ball if mport then gui cursor show pause 500 else if ipsFlag% then circle ballRad,ballRad,ballRad,2,,clr(cBK),clr(0) ' red circle 760,ballRad,ballRad,2,,clr(cBK),clr(2) ' blue circle 650,120,ballRad,2,,clr(cBK),clr(3) ' yellow circle ballRad*2,440,ballRad,2,,clr(cBK),clr(6) ' orange circle 600,380,ballRad,2,,clr(cBK),clr(5) ' magenta else blit write #1,10,1,26,26 blit write #3,290,1,26,26 blit write #4,280,79,26,26 blit write #7,10,215,26,26 blit write #6,288,210,26,26 endif endif charx = 0 : chary = 500 PutString("Press a key to begin...") do while inkey$ <> "" : loop ' clear any key presses do : loop until (inkey$ <> "") or newclick ' wait for key press newclick = 0 cls rgb(white) if ipsFlag% then: blit read #13,0,132,85,66: endif charx = 245 : chary = 10 PutString("CHEMICAL CHAOS") if cputype%=CMM2% then line 240,37,545,37,4,0 text 565,20,"v1.2 by vegipete, Jan 2021","LT",1,1,0,rgb(white) else if ipsFlag% then: font 2: else: font 7: endif ls$="v1.3 by vegipete, Jan 2021 (F4 by lizby)" ly%=mm.fontheight+2 lx%=mm.hres/2 - len(ls$)/2*mm.fontwidth text lx%,ly%,ls$,,,,,rgb(black),rgb(white) ly%=ly%+mm.fontheight+2 endif movecount(1) = 0 ' total keypress this run movecount(4) = 0 '=========================================== do if MixVials() = 0 then exit do ' no more levels ShowLevel movecount(2) = 0 ' total keypress this level movecount(3) = 0 ' total keypress this attempt movecount(5) = 0 movecount(6) = 0 ShowCounts do i = GetBall() if i then PutBall(i) if TestDone() then exit do ' this level has been defused if gameover then exit do ' player quit loop if cputype%=CMM2% then sprite hide 1 if gameover then exit do ' player quit ShowSafe ShuffleBCols levels = levels + 1 do : loop until (inkey$ <> "") or newclick ' wait for keypress do : loop until inkey$ = "" ' clear any keypresses newclick = 0 xpos=1 if cputype%=f4% then box 0,42,mm.hres,mm.vres-42,0,rgb(white),rgb(white) DrawArrow(xpos,UPARROW) ly%=42 ' where "Level #" will be printed endif loop if mport then settick 0, PeriodInt controller mouse close mport-1 pause 20 endif open "CCRedHand.spr" for random as #1 seek #1, 324 print #1, left$(str$(movecount(7)) + space$(15), 12); seek #1, 342 print #1, left$(str$(movecount(8)) + space$(15), 12); close #1 if mport then gui cursor off charx = 20 chary = 400 if gameover then ' player quit PutString("Send in the HazMat team...") else PutString("All is well. Chaos has been tamed.") pause 2500 mode 1,8 endif print "Type 'RUN' to play again." end '=========================================== sub LeftClick newclick = 1 handx = mouse(x,mport-1) handy = mouse(y,mport-1) if mport then gui cursor handx,handy end sub '=========================================== sub PeriodInt if mport then gui cursor mouse(x,mport-1),mouse(y,mport-1) end sub '=========================================== ' Draw the pth vial, erasing anything that might be there already ' p = [1,nvials] sub ShowVial(p) local integer x if mport then gui cursor hide if cputype%=CMM2% then blit 36,0,80*p-40,200,66,168,sp else if not ipsFlag% then blit write #9,46*(p-1),100,46,120 else x=90*(p-1)' 10 is spacing between vial tops line x+10,ballRad*6,x+ballRad*2+24,ballRad*6,2,clr(cBK) line x+14,ballRad*6,x+14,ballRad*13+8,2,clr(cBK) line x+18+ballRad*2,ballRad*6,x+18+ballRad*2,ballRad*13+8,2,clr(cBK) arc x+16+ballRad,ballRad*13+9,ballRad,ballRad+1,90,270,clr(cBK) endif endif if mport then gui cursor show end sub '=========================================== ' Draw ball number n at yth level in xth vial (lowest first) ' n = [1-7] colour ' x = [1-9] vial ' y = [0-4] level (0 = above) sub DrawBall(n,x,y) local xpos,ypos ' print "nxy: ",n,x,y if cputype%=CMM2% then if y then ypos = 397-36*y ' ball in vial else ypos = 120 ' ball above vial endif if mport then gui cursor hide if n then blit 0,ballcols(n-1)*36,80*x-25,ypos,36,36,sp,4 ' coloured ball else blit 36,216,80*x-25,ypos,36,36,sp,4 ' blank ball endif else ' F4 if y then ' ball in vial if not ipsFlag% then ypos = 238-26*y else ypos = ballRad*(17-(y*2))+5 endif else ' ball above vial if not ipsFlag% then ypos = 48 else ypos=ballRad*3 endif endif ' blit write #9,46*(x-1)+9,100,26,26 xpos=(x-1)*90+16+ballRad if n then ' coloured ball if not ipsFlag% then blit write n,46*(x-1)+9,ypos,26,26 else circle xpos,ypos,ballRad,2,,clr(cBK),clr(n-1) endif else ' blank ball if not ipsFlag% then blit write #12,46*(x-1)+9,ypos,26,26 else ' circle xpos,ballRad*(17-(y*2))+5,ballRad,0,,clr(cW),clr(cW) circle xpos,ypos,ballRad,0,,clr(cW),clr(cW) endif endif endif if mport then gui cursor show end sub '=========================================== ' Shuffle the ball colours around for variety sub ShuffleBCols local i, tmp, n for i = 0 to 6 n = int(rnd * 7) tmp = ballcols(i) ballcols(i) = ballcols(n) ballcols(n) = tmp next i end sub '=========================================== ' Show current level ' nvials is of interest, as is vials(9,4) sub ShowLevel local i,j if mport then gui cursor hide box 0,95,MM.HRES,310,0,rgb(white),rgb(white) ' erase vials and "SAFE" message for i = 1 to nvials ShowVial(i) for j = 1 to 4 DrawBall(vials(i,j),i,j+1) next j next i if xpos > nvials then xpos = nvials charx = 100 : chary = 400 a$="Level " + str$(levelball) + "." + str$(levelnum) if cputype%=cmm2% then PutString(a$+" ") else text mm.hres/2,40,a$,c,2 endif if mport then gui cursor show end sub '=========================================== function TestDone() local i,j TestDone = 0 for i = 1 to nvials for j = 2 to 4 if vials(i,j) <> vials(i,1) then exit function next j next i TestDone = 1 end function '=========================================== ' return number of ball selected, ' return 0 if no ball selected function GetBall() local k,j,res local integer x,x2,y2 if cputype%=CMM2% then sprite show 1,80*xpos-25,160,1,0 ' arrow up else if not ipsFlag% then blit write #8,46*(xpos-1)+9,72,26,26 else drawArrow(xpos,UPARROW) ' x=90*(xpos-1) ' x2=x+14+ballRad*2: y2=ballRad*5 ' box x,y2-radball,85,radball*2,,clr(cW),clr(cW) ' blank the space ' triangle x+14+ballRad,ballRad*4,x2,y2,x+14,ballRad*5,clr(cBK),clr(cBK) ' box x+7+ballRad,ballRad*5,14,ballRad*.8,,clr(cBK),clr(cBK) endif endif GetBall = 0 do k = asc(ucase$(inkey$)) ' ? k;" "; CheckNewClick(k) select case k case 130 ' left arrow if xpos > 1 then AnotherKeyPress xpos = xpos - 1 sprite show 1,80*xpos-25,160,1,0 ' draw up arrow endif ?"glk";str$(xpos);" "; case 131 ' right arrow if xpos < nvials then AnotherKeyPress xpos = xpos + 1 sprite show 1,80*xpos-25,160,1,0 ' draw up arrow endif ?"grk";str$(xpos);" "; case 67 ' "C" toggle count data on and off ToggleCounts case 27 ' [ESC] if inkey$ = "[" then ' PC keyboard arrow ls$=inkey$ if ls$="C" then ' right arrow if xpos < nvials then ' don't count AnotherKeyPress xpos = xpos + 1 ' sprite show 1,80*xpos-25,160,1,0 ' draw up arrow if not ipsFlag% then blit write #12,46*(xpos-2)+9,72,26,26 ' draw blank blit write #8,46*(xpos-1)+9,72,26,26 ' draw up arrow else DrawBlank(xpos-1) DrawArrow(xpos,UPARROW) endif endif elseif ls$="D" then ' left arrow if xpos > 1 then ' don't count AnotherKeyPress xpos = xpos - 1 ' sprite show 1,80*xpos-25,160,1,0 ' draw up arrow if not ipsFlag% then blit write #12,46*(xpos)+9,72,26,26 ' draw blank blit write #8,46*(xpos-1)+9,72,26,26 ' draw up arrow else ' ? "LN458 ": do: a$=inkey$: loop while a$="": ? DrawBlank(xpos+1) DrawArrow(xpos,UPARROW) ' ? "LN461 ": do: a$=inkey$: loop while a$="": ? endif endif endif else gameover = 1 exit do endif case 32 ' [SPACE] - select top ball from this vial AnotherKeyPress j = 4 res = 0 do if vials(xpos,j) > 0 then ' found a ball res = xpos movingball = vials(xpos,j) ' actual ball colour exit do endif j = j - 1 loop until j = 0 if res then vials(xpos,j) = 0 ' clear location DrawBall(0,res,j+1) ' erase ball from vial GetBall = res exit do endif case 82 ' "R" restart AnotherKeyPress movecount(3) = 0 ' total keypress this attempt movecount(6) = 0 ' total mouse click this attempt ShowCounts if cputype%=CMM2% then math scale vialsbak(),1,vials() ' restore starting configuration else for li%=0 to 9 ' vials(9,4) for lj%=0 to 4 vials(li%,lj%)=vialsbak(li%,lj%) next lj% next li% endif ShowLevel exit do end select loop end function '=========================================== ' take top ball from src and put it somewhere sub PutBall(src) local j,k if cputype%=CMM2% then sprite show 1,80*xpos-25,160,1,2 ' arrow down else if not ipsFlag% then blit write #10,46*(xpos-1)+9,72,26,26 else DrawArrow(xpos,DOWNARROW) ' x=90*(xpos-1) ' x2=x+14+ballRad*2: y2=ballRad*5 ' ? "box ";x;" ";y2;" ";y2-ballrad ' box x,y2-ballRad,80,ballRad*2,,clr(cW),clr(cW) ' blank the space ' ' draw down arrow ' triangle x+14+ballRad,ballRad*6-1,x2,y2,x+14,ballRad*5,BLK,BLK ' box x+7+ballRad,ballRad*4.1,14,ballRad,,BLK,BLK endif endif DrawBall(movingball,src,0) ' coloured ball above vial do k = asc(ucase$(inkey$)) CheckNewClick(k) select case k case 130 ' left arrow if xpos > 1 then AnotherKeyPress DrawBall(0,xpos,0) ' erase coloured ball above vial xpos = xpos - 1 DrawBall(movingball,xpos,0) ' draw coloured ball above vial sprite show 1,80*xpos-25,160,1,2 ' draw down arrow endif case 131 ' right arrow if xpos < nvials then AnotherKeyPress DrawBall(0,xpos-1,0) ' erase coloured ball above vial DrawBlank(xPos-2) xpos = xpos + 1 DrawBall(movingball,xpos,0) ' draw coloured ball above vial sprite show 1,80*xpos-25,160,1,2 ' draw down arrow endif case 90 ' [Z/z] 'undocumented' undo command - replace wrongly selected ball AnotherKeyPress DrawBall(0,xpos,0) ' erase coloured ball above pointer for j = 1 to 4 if vials(src,j) = 0 then ' find top spot vials(src,j) = movingball ' put the ball back DrawBall(movingball,src,j+1) ' re-draw coloured ball in vial exit do endif next j case 67 ' "C" toggle count data on and off ToggleCounts case 27 ' [ESC] if inkey$ = "[" then ' PC keyboard arrow ls$=inkey$ if ls$="C" then ' right arrow if xpos < nvials then ' don't count AnotherKeyPress DrawBall(0,xpos,0) ' clear prior coloured ball above vial DrawBlank(xpos) ' clear prior arrow xpos = xpos + 1 DrawBall(movingball,xpos,0) ' draw coloured ball above vial if not ipsFlag% then blit write #12,46*(xpos-2)+9,46,26,26 ' draw blank over ball blit write #12,46*(xpos-2)+9,72,26,26 ' draw blank over arrow blit write #10,46*(xpos-1)+9,72,26,26 ' draw down arrow else DrawArrow(xpos,DOWNARROW) endif endif elseif ls$="D" then ' left arrow if xpos > 1 then ' don't count AnotherKeyPress if not ipsFlag% then xpos = xpos - 1 blit write #12,46*(xpos)+9,46,26,26 ' draw blank over ball blit write #12,46*(xpos)+9,72,26,26 ' draw blank over arrow blit write #10,46*(xpos-1)+9,72,26,26 ' draw down arrow else DrawBall(0,xpos,0)' clear coloured ball above vial DrawBlank(xpos) ' clear prior arrow xpos = xpos - 1 DrawBall(movingball,xpos,0) ' draw coloured ball above vial DrawArrow(xpos,DOWNARROW) ' sprite show 1,80*xpos-25,160,1,0 ' draw up arrow endif endif endif else gameover = 1 exit do endif case 32 ' [SPACE] - place ball if cputype%=CMM2% then sprite show 1,80*xpos-25,160,1,2 ' draw down arrow else if not ipsFlag% then blit write #10,46*(xpos-1)+9,72,26,26 else endif endif if vials(xpos,4) = 0 then ' there is room in this vial AnotherKeyPress top = 0 for j = 1 to 4 if vials(xpos,j) = 0 then ' found a spot if (top = 0) or (top = movingball) then vials(xpos,j) = movingball ' move the ball DrawBall(0,xpos,0) ' erase coloured ball above vial DrawBall(movingball,xpos,j+1) ' draw coloured ball in vial exit do endif else top = vials(xpos,j) endif next j endif case 82 ' "R" restart AnotherKeyPress movecount(3) = 0 ' total keypress this attempt movecount(6) = 0 ' total mouse click this attempt ShowCounts if cputype%=CMM2% then math scale vialsbak(),1,vials() ' restore starting configuration else ' vials(9,4) for li%=0 to 9: for lj%=0 to 4 vialsbak(li%,lj%)=vials(li%,lj%) next lj%: next li% endif ShowLevel exit do end select loop movingball = 0 end sub '=========================================== sub CheckNewClick(k) if newclick then newclick = 0 if handy > 208 and handy < 350 then select case handx case 45 to 85 PickVial(1,k) case 125 to 165 PickVial(2,k) case 205 to 245 PickVial(3,k) case 285 to 325 PickVial(4,k) case 365 to 405 PickVial(5,k) case 445 to 485 PickVial(6,k) case 525 to 565 PickVial(7,k) case 605 to 645 PickVial(8,k) case 685 to 725 PickVial(9,k) end select endif endif end sub '=========================================== sub PickVial(n,k) local c$ if nvials >= n then if mport then gui cursor hide DrawBall(0,xpos,0) xpos = n DrawBall(movingball,xpos,0) if mport then gui cursor show movecount(1) = movecount(1) - 1 ' undo keypress this game movecount(2) = movecount(2) - 1 ' undo keypress this level movecount(3) = movecount(3) - 1 ' undo keypress this attempt movecount(7) = movecount(7) - 1 ' remove impending spurious keycount increment movecount(4) = movecount(4) + 1 ' another mouse click this game movecount(5) = movecount(5) + 1 ' another mouse click this level movecount(6) = movecount(6) + 1 ' another mouse click this attempt movecount(8) = movecount(8) + 1 k = 32 ' simulate space bar to grab/release ball endif end sub '=========================================== sub AnotherKeyPress local c$ movecount(1) = movecount(1) + 1 ' another keypress this level movecount(2) = movecount(2) + 1 ' another keypress this level movecount(3) = movecount(3) + 1 ' another keypress this attempt movecount(7) = movecount(7) + 1 ShowCounts end sub '=========================================== sub ShowCounts if countvisible then text 165,572," "+str$(movecount(1))+" ","CT",7,1,0,&hFFFFFF text 165,562," "+str$(movecount(2))+" ","CT",7,1,0,&hFFFFFF text 165,552," "+str$(movecount(3))+" ","CT",7,1,0,&hFFFFFF text 165,582," "+str$(movecount(7))+" ","CT",7,1,0,&hFFFFFF text 235,572," "+str$(movecount(4))+" ","CT",7,1,0,&hFFFFFF text 235,562," "+str$(movecount(5))+" ","CT",7,1,0,&hFFFFFF text 235,552," "+str$(movecount(6))+" ","CT",7,1,0,&hFFFFFF text 235,582," "+str$(movecount(8))+" ","CT",7,1,0,&hFFFFFF end if end sub '=========================================== sub ToggleCounts if countvisible then countvisible = 0 box 50,530,225,62,1,&hFFFFFF,&hFFFFFF else countvisible = 1 text 165,530,"Key","CT",7,1,0,&hFFFFFF text 165,540,"Strokes","CT",7,1,0,&hFFFFFF text 235,530,"Mouse","CT",7,1,0,&hFFFFFF text 235,540,"Clicks","CT",7,1,0,&hFFFFFF text 125,550,"This attempt","RT",7,1,0,&hFFFFFF text 125,560,"This level","RT",7,1,0,&hFFFFFF text 125,570,"This game","RT",7,1,0,&hFFFFFF text 125,580,"Total","RT",7,1,0,&hFFFFFF box 130,550,141,41,1,0 line 130,560,270,560,1,0 line 130,570,270,570,1,0 line 130,580,270,580,1,0 line 200,550,200,589,1,0 ShowCounts end if end sub '=========================================== sub PutChar(c$) local cn = asc(c$) - 32 if cn < 0 then exit sub if cn > 95 then exit sub blit 102+(cn mod 16)*21,int(cn/16)*30,charx,chary,21,30,sp charx = charx + 21 if charx > MM.HRES then charx = 0 chary = chary + 30 endif end sub '=========================================== sub PutString(s$) local i if cputype%=cmm2% then for i = 1 to len(s$) PutChar(mid$(s$,i,1)) next i else ' Armmite F4 if chary = 10 then ' first line if ipsFlag% then: font 4: else: font 2: endif i=mm.hres/2 - len(s$)/2*mm.fontwidth text i,0,s$,,,,rgb(black),rgb(white) if ipsFlag% then: ly%=mm.fontheight+42: else: ly%=mm.fontheight+14: endif else if ipsFlag% then: font 3: else: font 1: endif text 0,ly%,s$,,,,rgb(black),rgb(white) ly%=ly%+mm.fontheight endif endif end sub '=========================================== sub ShowSafe if cputype%=CMM2% then rbox MM.HRES/2-220, 95,360,100,50,&h00FF21,&h00FF21 ' greenish frame rbox MM.HRES/2-210,105,340, 80,40,rgb(white),rgb(white) blit 180,180,MM.HRES/2-170,110,260,70,sp else if not ipsFlag% then box 0,44,320,54,,rgb(white),rgb(white) blit write #11,130,44,190,48 ' draw SAFE! else DrawBlank(xpos) ' blank the last arrow text mm.hres/2,ballRad*3,"S A F E !",C,5,,rgb(yellow),rgb(green) endif endif end sub '=========================================== ' Read another level from the data function MixVials() local i,j,mix local c$ if cputype%=CMM2% then math set 0,vials() ' start with empty vials else for li%=0 to 9 ' vials(9,4) for lj%=0 to 4 vials(li%,lj%)=0 next lj% next li% endif read nballs if nballs = 0 then MixVials = 0 exit function endif if cputype%=CMM2% then page write 2 ' don't want to see prints on screen print levels, ' will appear on console if attached if nballs = levelball then levelnum = levelnum + 1 else levelnum = 1 levelball = nballs endif m$ = "" read nvials if nvials = -1 then nvials = nballs + 2 for i = 1 to nballs m$ = m$ + string$(4,str$(i)) next i for i = 1 to len(m$) ' scramble m$ c$ = mid$(m$,i,1) j = int(rnd * len(m$)) + 1 ' LB mid$(m$,i,1) = mid$(m$,j,1) ' LB mid$(m$,j,1) = c$ ls$ = mid$(m$,j,1) m$=mid$(m$,1,i-1)+ls$+mid$(m$,i+1) m$=mid$(m$,1,j-1)+c$+mid$(m$,j+1) next i print "random "; for i = len(m$) to 1 step -1 print mid$(m$,i,1); next i for i = 1 to nvials ' fill with data from m$ for j = 1 to 4 vials(i,j) = val(left$(m$,1)) m$ = mid$(m$,2) next j next i else for i = 1 to nvials ' fill with data read mix m$ = m$ + str$(mix) for j = 1 to 4 vials(i,j) = mix mod 10 mix = mix \ 10 next j next i print "built in "; m$ endif if cputype%=CMM2% then math scale vials(),1,vialsbak() ' save starting configuration page write 0 else for li%=0 to 9 ' vials(9,4) for lj%=0 to 4 vialsbak(li%,lj%)=vials(li%,lj%) next lj% next li% endif MixVials = 1 end function '=========================================== sub F4_setup static integer h=69,w=65 local x,y ' print "F4_setup" backlight 50 if MM.INFO$(LCDPANEL)<>"IPS_4_16" then Load IMAGE "ChemiChaosSprites800.bmp" for li%=1 to 12: On error skip: Blit CLOSE li%: next li% Blit READ #1,0,0,26,26: Blit READ #2,0,25,26,26: Blit READ #3,0,51,26,26 Blit READ #4,0,76,26,26: Blit READ #5,0,102,26,26 Blit READ #6,0,127,26,26: Blit READ #7,0,152,26,26 Blit READ #8,26,126,26,26 ' up arrow Blit READ #9,27,0,46,120 ' test tube Blit read #11,130,130,190,48 ' "SAFE!" Load IMAGE "DownArrow.bmp" Blit Read #10,0,0,26,26 ' down arrow CLS RGB(white) Blit read #12,0,0,26,26 ' blank sprite CLS RGB(white) else ipsFlag%=1 ' NEW: but insufficient memory with IPS 800x480 LCD--must draw circles, etc. ' Blit READ #1,0,0,65,69: y=y+h: Blit READ #2,0,y,65,69: y=y+h: Blit READ #3,0,y,65,69 ' y=y+h: Blit READ #4,0,y,65,69: y=y+h: Blit READ #5,0,y,65,69 ' y=y+h: Blit READ #6,0,y,65,69: y=y+h: Blit READ #7,0,y,65,69 ' y=y-h: Blit READ #8,w+1,165,69,26 ' up arrow ' Blit READ #9,66,0,118,320 ' test tube ' Blit read #11,326,347,460,130 ' "SAFE!" ' Load IMAGE "DownArrow_IPS.bmp" ' Blit Read #10,0,0,w,h ' down arrow ' CLS RGB(white) ' Blit read #12,0,0,w,h ' blank sprite ' CLS RGB(white) end sub sub DrawArrow(slot,updownFlag) ' updownFlag: 0=down,1=up local integer x,x2,y2,y3 x=90*(slot-1) x2=x+14+ballRad*2: y2=ballRad*5: y3=ballRad*4 ' ? "x,y3,Blank box; <CR> ";x;" ";y3;: do:a$=inkey$:loop while a$="":? blit write #13,x,y3,85,66 ' box x,y3,85,radball*2,,clr(cW),clr(cW) ' blank the space ' print "x,x2,y2 <Enter>";x;" ";x2;" ";y2;" ";: ' do: a$=inkey$: loop while a$="": ? if updownFlag then ' up arrow triangle x+14+ballRad,y3,x2,y2,x+14,ballRad*5,clr(cBK),clr(cBK) box x+7+ballRad,ballRad*5,14,ballRad*.8,,clr(cBK),clr(cBK) else ' draw down arrow ' box x+1,y3,85,radball*2,,clr(cW),clr(cW) ' blank the space ' blit write #13,x,y3,85,66 triangle x+14+ballRad,ballRad*6-1,x2,y2,x+14,ballRad*5,BLK,BLK box x+7+ballRad,ballRad*4.1,14,ballRad,,BLK,BLK endif ' print "<Enter>";: do: a$=inkey$: loop while a$="": ? end sub sub DrawBlank(slot) local integer x,x2,y2,y3 x=90*(slot-1) x2=x+14+ballRad*2: y2=ballRad*5: y3=ballRad*4 ' ? "x,y3,Blank box; <CR> ";x;" ";y3;: do:a$=inkey$:loop while a$="":? blit write #13,x,y3,85,66 ' box x,y2-radball,85,radball*4,,clr(cW),clr(cW) ' blank the space end sub '=========================================== ' data format: ' #balls, #vials, ball pattern for each vial ' if #vials = -1 then fill (#balls + 2) vials ly gamelevels: data 1,2,11,11 ' trivial one to get started data 2,3,1221,2112,0 data 2,3,1212,2121,0 data 2,5,1121,1211,2111,1112,0 data 3,5,1231,3321,2231,0,0 ' this one can't be done in only 4 vials data 3,-1 data 3,-1 data 3,-1 data 3,4,1213,2231,3213,0 data 3,4,2313,2123,2311,0 data 3,4,2313,2232,1113,0 data 3,4,1211,3323,1232,0 data 3,4,2132,3221,3311,0 data 3,4,2221,2133,1133,0 'data 3,4,1233,1212,2133,0 'data 3,4,1232,3121,1323,0 data 4,-1 data 4,-1 data 4,-1 data 4,-1 data 4,5,2321,1412,4412,4333,0 data 4,5,4232,1231,2443,3114,0 data 4,5,3124,2121,2444,3331,0 data 4,5,1224,4232,4311,4133,0 data 4,5,2141,4333,3242,4121,0 data 5,-1 data 5,-1 data 5,-1 data 5,-1 data 5,-1 data 5,-1 data 5,6,5154,3321,4222,3415,1534,0 data 5,6,4131,2422,5412,5313,4553,0 data 5,6,2154,2543,5414,2251,1333,0 data 5,6,3214,2453,2431,2135,5541,0 data 6,-1 data 6,-1 data 6,-1 data 6,-1 data 6,-1 data 6,7,1642,5624,4161,3623,5432,5315,0 data 6,7,6413,5124,3531,4265,6153,6224,0 data 6,7,6342,5265,2341,4534,6152,6131,0 data 6,7,2151,5634,6436,6514,3431,2225,0 data 6,7,1324,4636,5413,6132,5562,5241,0 data 7,-1 data 7,-1 data 7,-1 data 7,-1 data 7,-1 data 7,-1 data 7,-1 data 7,8,2127,4665,4231,3776,4335,6151,4572,0 data 7,8,4311,5562,2346,7773,6245,6124,3751,0 data 7,8,2715,2136,2761,7634,5744,6552,3431,0 data 0,0 ' indicate end of data Edited 2021-04-24 05:34 by lizby PicoMite, Armmite F4, SensorKits, MMBasic Hardware, Games, etc. on fruitoftheshed |
||||
![]() |
![]() |
The Back Shed's forum code is written, and hosted, in Australia. | © JAQ Software 2025 |