REM Get sprite at http://dl.dropbox.com/u/15387474/SprtSheet2F.PNGDEFLNG A-ZSCREEN 12WorkPage& = _LOADIMAGE("Sprtsheet2f.png") 'create the sprite sheet page_COPYPALETTE WorkPage&, 0FrameNum& = 0: x1 = 100: y1 = 100: direction = 1: flap = 0: Active = 0:PRINT " use arrow keys, to move side,to side, up down. Esacpekey exits"SLEEP 2DO _DISPLAY _LIMIT 20 GOSUB Getkey CLS 'need to clear the page ready for new image GOSUB Showframe COLOR 14 LOCATE 20, 1: PRINT " Hello World, now just give me some dots to eat" '// I would like to see how to make him eat the above text. PLAY "MB <a15c20e15>" '//you can remark this out if it annoys youLOOP UNTIL INP(&H60) = 1SLEEPSYSTEMGetkey:IF _KEYDOWN(20480) THEN y1 = y1 + 4IF _KEYDOWN(18432) THEN y1 = y1 - 4IF _KEYDOWN(19200) THEN x1 = x1 - 4: direction = 2END IFIF _KEYDOWN(19712) THEN x1 = x1 + 4: direction = 1END IF_DELAY .05RETURNShowframe:SELECT CASE FrameNum& CASE 0 IF direction = 1 THEN _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (1, 1)-(94, 94) ELSE _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (94, 1)-(1, 94) END IF CASE 1 IF direction = 1 THEN _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (91, 0)-(188, 94) ELSE _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (188, 0)-(94, 94) END IFEND SELECTblink = blink + 1IF blink = 3 THEN blink = 0 FrameNum& = FrameNum& + 1END IFIF FrameNum& = 2 THEN FrameNum& = 0RETURN
REM Get sprite at http://dl.dropbox.com/u/15387474/SprtSheet2F.PNGDEFLNG A-ZVideo& = _NEWIMAGE(640, 480, 32)WorkPage& = _LOADIMAGE("Sprtsheet.png", 32) 'create the sprite sheet pageSCREEN Video&FrameNum& = 0: x1 = 100: y1 = 100: direction = 1: flap = 0: Active = 0:PRINT " use arrow keys, to move side,to side, up down. Esacpekey exits"SLEEP 2DO _DISPLAY _LIMIT 20 GOSUB Getkey CLS 'need to clear the page ready for new image GOSUB Showframe COLOR 14 LOCATE 20, 1: PRINT " Hello World, now just give me some dots to eat" '// I would like to see how to make him eat the above text. 'PLAY "MB <a15c20e15>" '//you can remark this out if it annoys youLOOP UNTIL INP(&H60) = 1SLEEPSYSTEMGetkey:IF _KEYDOWN(20480) THEN y1 = y1 + 4IF _KEYDOWN(18432) THEN y1 = y1 - 4IF _KEYDOWN(19200) THEN x1 = x1 - 4: direction = 2END IFIF _KEYDOWN(19712) THEN x1 = x1 + 4: direction = 1END IF_DELAY .05RETURNShowframe:SELECT CASE FrameNum& CASE 0 IF direction = 1 THEN _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (1, 1)-(94, 94) ELSE _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (94, 1)-(1, 94) END IF CASE 1 IF direction = 1 THEN _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (91, 0)-(188, 94) ELSE _PUTIMAGE (x1, y1)-(x1 + 94, y1 + 94), WorkPage&, 0, (188, 0)-(94, 94) END IFEND SELECTblink = blink + 1IF blink = 3 THEN blink = 0 FrameNum& = FrameNum& + 1END IFIF FrameNum& = 2 THEN FrameNum& = 0RETURN
REM Best version yet.DEFLNG A-ZDIM SHARED mx, my, mbl, mbrVideo& = _NEWIMAGE(800, 600, 32) 'page we actually draw onGrid& = _NEWIMAGE(800, 600, 32) 'grid to place over monitorSCREEN _NEWIMAGE(800, 600, 32) 'what we seeYellow& = _RGB32(255, 255, 0)MSBlue& = _RGB32(123, 104, 238)Black& = _RGB32(0, 0, 0)GOSUB MakemapDO _CLEARCOLOR Black&, Grid& _PUTIMAGE , Grid&, 0 'copy yellow lines of grid only _PUTIMAGE , Video&, 0 MousePoll r = INT(mx \ 30) 'row r1 = r * 30 'x1 r2 = r1 + 30 'x2 c = INT(my \ 30) 'column c1 = c * 30 'y1 c2 = c1 + 30 'y2 IF mbl = -1 THEN GOSUB LFillbox IF mbr = -1 THEN GOSUB RFillbox _DEST 0 LOCATE 1, 95: PRINT mx LOCATE 2, 95: PRINT my LOCATE 4, 95: PRINT r + 1 LOCATE 5, 95: PRINT c + 1LOOP UNTIL _KEYDOWN(27)SaveImage Video&, "PacMap0.bmp"_DEST 0LOCATE 10, 37: PRINT "FILE SAVED AS PacMap0.bmp"SOUND 1500, 1: SOUND 2000, 1SLEEPSCREEN 0_FREEIMAGE Video&_FREEIMAGE Grid&SYSTEM'------------------------------ SUBS -------------------RFillbox:IF mx < 748 THEN IF my < 566 THEN _DEST Video& LINE (r1, c1)-(r2, c2), Black&, BF 'erase box END IFEND IFRETURNLFillbox:IF mx < 748 THEN IF my < 566 THEN _DEST Video& LINE (r1, c1)-(r2, c2), MSBlue&, BF 'fill box END IFEND IFRETURNMakemap:_DEST Grid&FOR x = 0 TO 740 STEP 30 FOR y = 0 TO 560 STEP 30 LINE (x, y)-(x + 30, y + 30), Yellow&, B NEXT yNEXT xRETURNSUB SaveImage (image AS LONG, filename AS STRING)bytesperpixel& = _PIXELSIZE(image&)IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": ENDIF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24x& = _WIDTH(image&)y& = _HEIGHT(image&)b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + MKL$(0) + MKL$(0) + MKL$(0) + MKL$(0) 'partial BMP header info(???? to be filled later)IF bytesperpixel& = 1 THEN FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0)) cv& = _PALETTECOLOR(c&, image&) ' color attribute to read. b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte NEXTEND IFMID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)lastsource& = _SOURCE_SOURCE image&IF (x& AND 3) THEN padder$ = SPACE$(4 - (x& AND 3))FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data r$ = "" FOR px& = 0 TO x& - 1 c& = POINT(px&, py&) IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3) NEXT px& d$ = d$ + r$ + padder$NEXT py&_SOURCE lastsource&MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)b$ = b$ + d$ ' total file data bytes to create fileMID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"f& = FREEFILEOPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing fileOPEN filename$ + ext$ FOR BINARY AS #f&PUT #f&, , b$CLOSE #f&END SUBSUB MousePoll ()DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY: mbl = _MOUSEBUTTON(1): mbr = _MOUSEBUTTON(2)LOOPEND SUBSUB ButtonRelease ()IF mbl = 0 AND mbr = 0 THEN EXIT SUBWHILE mbl = -1 MousePollWENDWHILE mbr = -1 MousePollWENDEND SUB
REM Best version yet.DEFLNG A-ZDIM SHARED mx, my, mbl, mbrDIM SHARED PacMap(19, 25)Video& = _NEWIMAGE(800, 600, 32) 'page we actually draw onGrid& = _NEWIMAGE(800, 600, 32) 'grid to place over monitorText& = _NEWIMAGE(800, 600, 32)SCREEN _NEWIMAGE(800, 600, 32) 'what we seeYellow& = _RGB32(255, 255, 0)MSBlue& = _RGB32(123, 104, 238)Black& = _RGB32(0, 0, 0)Blok$ = CHR$(176): Blank$ = CHR$(32)GOSUB MakemapDO _CLEARCOLOR Black&, Grid& _PUTIMAGE , Grid&, 0 'copy yellow lines of grid only _PUTIMAGE , Video&, 0 MousePoll r = INT(mx \ 30) 'row r1 = r * 30 'x1 r2 = r1 + 30 'x2 c = INT(my \ 30) 'column c1 = c * 30 'y1 c2 = c1 + 30 'y2 IF mbl = -1 THEN GOSUB LFillbox IF mbr = -1 THEN GOSUB RFillbox IF _KEYDOWN(32) THEN _PUTIMAGE , Text&, 0 END IF _DEST 0 LOCATE 1, 95: PRINT mx LOCATE 2, 95: PRINT my LOCATE 4, 95: PRINT r + 1 LOCATE 5, 95: PRINT c + 1LOOP UNTIL _KEYDOWN(27)SaveImage Video&, "PacMap0.bmp"_DEST 0LOCATE 10, 37: PRINT "FILE SAVED AS PacMap0.bmp"SOUND 1500, 1: SOUND 2000, 1SLEEP 1SCREEN 0cycle = 0FOR c = 0 TO 18 FOR r = 0 TO 24 LOCATE c + 1, r + 1 'z = PacMap(c, r) z = PacMap(c, r) IF z = 0 THEN PRINT CHR$(32) ELSE PRINT CHR$(z) _DELAY .1 cycle = cycle + 1 LOCATE 1, 40: PRINT cycle NEXT rNEXT cSLEEP_FREEIMAGE Video&_FREEIMAGE Grid&_FREEIMAGE Text&SYSTEM'------------------------------ SUBS -------------------RFillbox:IF mx < 748 THEN IF my < 566 THEN _DEST Video& LINE (r1, c1)-(r2, c2), Black&, BF 'erase box _DEST Text& LOCATE c + 1, r + 1: PRINT Blank$ PacMap(c, r) = 32 END IFEND IFRETURNLFillbox:IF mx < 748 THEN IF my < 566 THEN _DEST Video& LINE (r1, c1)-(r2, c2), MSBlue&, BF 'fill box _DEST Text& LOCATE c + 1, r + 1: PRINT Blok$ PacMap(c, r) = 176 END IFEND IFRETURNMakemap:_DEST Grid&FOR x = 0 TO 740 STEP 30 FOR y = 0 TO 560 STEP 30 LINE (x, y)-(x + 30, y + 30), Yellow&, B NEXT yNEXT xRETURNSUB SaveImage (image AS LONG, filename AS STRING)bytesperpixel& = _PIXELSIZE(image&)IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": ENDIF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24x& = _WIDTH(image&)y& = _HEIGHT(image&)b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + MKL$(0) + MKL$(0) + MKL$(0) + MKL$(0) 'partial BMP header info(???? to be filled later)IF bytesperpixel& = 1 THEN FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0)) cv& = _PALETTECOLOR(c&, image&) ' color attribute to read. b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte NEXTEND IFMID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)lastsource& = _SOURCE_SOURCE image&IF (x& AND 3) THEN padder$ = SPACE$(4 - (x& AND 3))FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data r$ = "" FOR px& = 0 TO x& - 1 c& = POINT(px&, py&) IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3) NEXT px& d$ = d$ + r$ + padder$NEXT py&_SOURCE lastsource&MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)b$ = b$ + d$ ' total file data bytes to create fileMID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"f& = FREEFILEOPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing fileOPEN filename$ + ext$ FOR BINARY AS #f&PUT #f&, , b$CLOSE #f&END SUBSUB MousePoll ()DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY: mbl = _MOUSEBUTTON(1): mbr = _MOUSEBUTTON(2)LOOPEND SUBSUB ButtonRelease ()IF mbl = 0 AND mbr = 0 THEN EXIT SUBWHILE mbl = -1 MousePollWENDWHILE mbr = -1 MousePollWENDEND SUB
REM Best version yet.DEFLNG A-ZDIM SHARED mx, my, mbl, mbrDIM SHARED PacMap(19, 25)Video& = _NEWIMAGE(800, 600, 32) 'page we actually draw onGrid& = _NEWIMAGE(800, 600, 32) 'grid to place over monitorText& = _NEWIMAGE(800, 600, 32)SCREEN _NEWIMAGE(800, 600, 32) 'what we seeGOSUB InitYellow& = _RGB32(255, 255, 0)MSBlue& = _RGB32(123, 104, 238)Black& = _RGB32(0, 0, 0)Blok$ = CHR$(176): Blank$ = CHR$(32)GOSUB Makemap_MOUSESHOWDO _CLEARCOLOR Black&, Grid& _PUTIMAGE , Grid&, 0 'copy yellow lines of grid only _PUTIMAGE , Video&, 0 MousePoll r = INT(mx \ 30) 'row r1 = r * 30 'x1 r2 = r1 + 30 'x2 c = INT(my \ 30) 'column c1 = c * 30 'y1 c2 = c1 + 30 'y2 IF mbl = -1 THEN GOSUB LFillbox IF mbr = -1 THEN GOSUB RFillbox IF _KEYDOWN(32) THEN _PUTIMAGE , Text&, 0 END IF _DEST 0 LOCATE 1, 95: PRINT mx LOCATE 2, 95: PRINT my LOCATE 4, 95: PRINT r + 1 LOCATE 5, 95: PRINT c + 1LOOP UNTIL _KEYDOWN(27)GOSUB Savgrapmap 'save a bmp of it_DEST 0LOCATE 10, 37: PRINT "FILE SAVED AS PacMap0.BMP"LOCATE 13, 37: PRINT "FILE SAVED AS PacMap0.TXT"SOUND 1500, 1: SOUND 2000, 1SLEEP 1GOSUB Savdatamap 'save as data statements in textSLEEP_FREEIMAGE Video&_FREEIMAGE Grid&_FREEIMAGE Text&SYSTEM'------------------------------ SUBS -------------------Init:PRINT "Use left mice button to color cell blue"PRINT "Use right mice button to erase cell color to black"PRINT "When finished drawing press ESCAPE"PRINT "Program will save a copy as BMP named PacMap0.BMP"PRINT "Program will save a copy as DATA statements in text form named PacMap0.TXT"PRINT "Press any key"dummy$ = INPUT$(1)CLSRETURNSavgrapmap:SaveImage Video&, "PacMap0.bmp"RETURNSavdatamap:SCREEN 0Temp$ = "": Comma$ = ",": Savfilename$ = "PacMap0.txt"cycle = 0FOR c = 0 TO 18 FOR r = 0 TO 24 LOCATE c + 1, r + 1 z = PacMap(c, r) IF z = 0 THEN z = 32 PRINT CHR$(32) ELSE PRINT CHR$(z) END IF temp1$ = LTRIM$(STR$(z)) Temp$ = Temp$ + temp1$ + Comma$ NEXT r GOSUB Txtsaver Temp$ = ""NEXT cTemp$ = ""RETURNTxtsaver:z = LEN(Temp$)Temp$ = LEFT$(Temp$, z - 1)Temp$ = "DATA " + Temp$OPEN Savfilename$ FOR APPEND AS #1PRINT #1, Temp$CLOSE #1RETURNRFillbox:IF mx < 748 THEN IF my < 566 THEN _DEST Video& LINE (r1, c1)-(r2, c2), Black&, BF 'erase box _DEST Text& LOCATE c + 1, r + 1: PRINT Blank$ PacMap(c, r) = 32 END IFEND IFRETURNLFillbox:IF mx < 748 THEN IF my < 566 THEN _DEST Video& LINE (r1, c1)-(r2, c2), MSBlue&, BF 'fill box _DEST Text& LOCATE c + 1, r + 1: PRINT Blok$ PacMap(c, r) = 176 END IFEND IFRETURNMakemap:_DEST Grid&FOR x = 0 TO 740 STEP 30 FOR y = 0 TO 560 STEP 30 LINE (x, y)-(x + 30, y + 30), Yellow&, B NEXT yNEXT xRETURNSUB SaveImage (image AS LONG, filename AS STRING)bytesperpixel& = _PIXELSIZE(image&)IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": ENDIF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24x& = _WIDTH(image&)y& = _HEIGHT(image&)b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + MKL$(0) + MKL$(0) + MKL$(0) + MKL$(0) 'partial BMP header info(???? to be filled later)IF bytesperpixel& = 1 THEN FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0)) cv& = _PALETTECOLOR(c&, image&) ' color attribute to read. b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte NEXTEND IFMID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)lastsource& = _SOURCE_SOURCE image&IF (x& AND 3) THEN padder$ = SPACE$(4 - (x& AND 3))FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data r$ = "" FOR px& = 0 TO x& - 1 c& = POINT(px&, py&) IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3) NEXT px& d$ = d$ + r$ + padder$NEXT py&_SOURCE lastsource&MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)b$ = b$ + d$ ' total file data bytes to create fileMID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"f& = FREEFILEOPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing fileOPEN filename$ + ext$ FOR BINARY AS #f&PUT #f&, , b$CLOSE #f&END SUBSUB MousePoll ()DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY: mbl = _MOUSEBUTTON(1): mbr = _MOUSEBUTTON(2)LOOPEND SUBSUB ButtonRelease ()IF mbl = 0 AND mbr = 0 THEN EXIT SUBWHILE mbl = -1 MousePollWENDWHILE mbr = -1 MousePollWENDEND SUB
REM Demo of Pac Map.DEFLNG A-ZDIM SHARED mx, my, mbl, mbrDIM SHARED PacMap(19, 25)SCREEN _NEWIMAGE(800, 600, 32) 'what we seeGOSUB FilldimDOLOOP UNTIL _KEYDOWN(27)SLEEPSCREEN 0SYSTEMFilldim:FOR c = 0 TO 18 FOR r = 0 TO 24 READ Z PacMap(c, r) = Z 'PacMap(r, c) = Z IF Z = 176 THEN LINE (r * 30, c * 30)-((r * 30) + 29, (c * 30) + 29), _RGB32(255, 255, 0), BF END IF NEXT rNEXT cRETURN'-------------------------- MAP --------------------------------------DATA 176,176,176,176,176,176,176,176,176,176,176,176,32,176,176,176,176,176,176,176,176,176,176,176,176DATA 176,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,176DATA 176,32,176,176,176,176,176,176,176,176,176,32,176,32,176,176,176,176,176,176,176,176,176,32,176DATA 176,32,176,32,32,32,32,32,32,32,32,32,176,32,176,32,32,32,32,32,32,32,176,32,176DATA 176,32,176,32,176,176,176,176,32,176,176,32,176,32,176,32,176,176,176,176,176,32,176,32,176DATA 176,32,176,32,176,32,32,32,32,32,176,32,176,32,176,32,32,32,32,32,32,32,176,32,176DATA 176,32,176,32,176,32,176,176,32,176,176,32,176,32,176,32,176,32,176,32,176,32,32,32,176DATA 176,32,32,32,176,32,32,32,32,32,32,32,32,32,32,32,176,32,176,32,176,32,176,32,176DATA 176,32,176,32,176,32,176,176,176,32,176,176,32,176,176,32,32,32,176,32,32,32,176,32,176DATA 32,32,176,32,32,32,32,32,32,32,176,32,32,32,176,32,176,176,176,176,176,32,176,32,32DATA 176,32,176,32,176,32,176,176,176,32,176,176,176,176,176,32,32,32,176,32,32,32,176,32,176DATA 176,32,32,32,176,32,32,32,32,32,32,32,32,32,32,32,176,32,176,32,176,32,176,32,176DATA 176,32,176,32,176,32,176,176,32,176,176,32,176,32,176,32,176,32,176,32,176,32,32,32,176DATA 176,32,176,32,176,32,32,32,32,32,176,32,176,32,176,32,32,32,32,32,32,32,176,32,176DATA 176,32,176,32,176,176,176,176,32,176,176,32,176,32,176,32,176,176,176,176,176,32,176,32,176DATA 176,32,176,32,32,32,32,32,32,32,32,32,176,32,176,32,32,32,32,32,32,32,176,32,176DATA 176,32,176,176,176,176,176,176,176,176,176,32,176,32,176,176,176,176,176,176,176,176,176,32,176DATA 176,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,176DATA 176,176,176,176,176,176,176,176,176,176,176,176,32,176,176,176,176,176,176,176,176,176,176,176,176