News:

Welcome to RetroCoders Community

Main Menu

Sprite Editor - kind of...

Started by johnno56, May 06, 2023, 01:52 PM

Previous topic - Next topic

johnno56

I figured that I would relocate the info about the sprite editor to its own topic.

I have added 3 functions to the editor. New, Save and Quit.

Not much else has changed. Select a colour from the palette using left mouse button (LMB). Place the current colour on the main grid using the LMB. To erase a main grid cell. Hover over the cell and press SPACE.

NEW: Erases the entire main grid.
QUIT: No prizes for a correct guess... lol
SAVE: Not quite what you think. **

** As BAM cannot save files, in the traditional sense, save is done a little differently.

At the moment 'save' will create a file 'BAM Data test.txt' (in my case - the Downloads folder)
This file will recreate the saved image "old school". BAM will scan the main grid and store the colours into an array. Then create a small program that recreates an independent image using the old "read data statements" method using the LPRINT command.

This is primarily done to test LPRINT, _STARTSPOOL and _ENDSPOOL. The saved program can be loaded into QB64 or BAM to recreate the image (squint - it is only 8x8 pixels) For some reason BAM produces multiple copies of the saved text file - work in progress. Eventually, I want to use this method to create and image that will then create a LETCHR$() so as to redefine ASCII characters - This could be used to perhaps make simple 8 bit fonts... maybe....

Screen 7: Cls

gridCol = 7
fillCol = 15
EraseCol = 0
currentColour = 7
gridSize = 8

'
'		Main Grid
'
Dim GridA(8, 8)
Dim GridB(8, 8)
posX = 0
posY = 0
canSave = false

'		Draw Main Grid
'
for x = 0 to 140 step 20
	for y = 0 to 140 step 20
		line(x, y)-step(20, 20), GridCol, b
	next
next

'		Draw Sample Grid
'
for imageX = 0 to 7
	for imageY = 0 to 7
		Line(224 + (imagex*4),16 + (imagey*4))-step(4,4),GridCol,b
	next
next

'		Draw Current Colour Box
line(234,60)-step(12, 12), GridCol, b

'		Draw Colour Palette
'
for x = 1 to 5: line(190 + ((x - 1) * 20), 80)-step(20, 20), x, bf: next
for x = 1 to 5: line(190 + ((x - 1) * 20), 100)-step(20, 20), x + 5, bf: next
for x = 1 to 5: line(190 + ((x - 1) * 20), 120)-step(20, 20), x + 10, bf: next

'		Draw Palette Grid
'
for x = 0 to 4
	for y = 0 to 2
		line(190 + (x * 20), 80 + (y * 20))-step(20, 20), GridCol, b
	next
next

do while inkey$ <> chr$(27)

	'		Assign mouse functions
	'
	mb = _mousebutton
	mx = _mousex
	my = _mousey
	
	'locate 1,1:COLOR 11: print using "MX: ###";mx
	'locate 2,1:COLOR 12: print using "MY: ###";my
	'locate 3,1:print using "MB: ###";mb
	'locate 4,1:print using "COL ###";currentColour

  '   PLACE CURRENT COLOUR ON MAIN GRID
  '
	if mb = 1 and mx > 0 and mx < 160 and my > 0 and my < 160 then
		paint(mx, my), currentColour, GridCol
	end if

	'		DISPLAY CURRENT COLOUR
	'
	if mb = 1 and mx > 190 and mx < 290 and my > 80 and my < 140 then
		currentColour = point(mx, my)
		line(234,60)-step(12, 12), currentColour, bf
	end if
	line(234,60)-step(12, 12), GridCol, b
	
	'
	'   UPDATE SPRITE
	'
	for imageX = 0 to 7
		for imageY = 0 to 7
			GridB(posx,posy) = point(10 + (imagex * 20), 10 + (imagey * 20))
			Line(224 + (imagex*4),16 + (imagey*4))-step(4,4),GridB(posx,posy),bf
			Line(224 + (imagex*4),16 + (imagey*4))-step(4,4),GridCol,b
		next
	next		

	'		ERASE MAIN GRID CELL UNDER MOUSE POINTER
	'
	if inkey$ = " " and mx > 0 and mx < 160 and my > 0 and my < 160 and point(mx, my) <> GridCol then
		paint(mx, my), EraseCol, GridCol
	end if
	
	'		BUTTON TEST
	'
	LOCATE 23, 2: COLOR GridCol: PRINT "NEW"
	LOCATE 23, 9: COLOR GridCol: PRINT "SAVE"
	LOCATE 23, 17: COLOR GridCol: PRINT "QUIT"
	
	'			new
	'
	if mx > 8 and mx < 31 and my > 175 and my <184 then
		COLOR 10: LOCATE 23, 2: PRINT "NEW"
		if mb = 1 then
			for x = 0 to 140 step 20
				for y = 0 to 140 step 20
					line(x, y)-step(20, 20), 0, bf
					line(x, y)-step(20, 20), GridCol, b
				next
			next
		end if
	end if
	
	'			save
	'
	if mx > 64 and mx <95 and my >175 and my < 184 then
		COLOR 11: LOCATE 23, 9: PRINT "SAVE"
		if mb =1 then
			_STARTSPOOL "BAM Data test.txt"
				LPRINT "SCREEN 7: CLS"
				LPRINT "DIM grid(8,8)"
				LPRINT "FOR y = 0 TO 7"
				LPRINT "   FOR x = 0 TO 7"
				LPRINT "      READ grid(x,y)"
				LPRINT "      PSET(x,y),grid(x,y)"
				LPRINT "   NEXT x"
				LPRINT "NEXT y"
				for imageY = 0 to 7
					LPRINT "DATA " + point(10 + (0 * 20), 10 + (imagey * 20)) + "," + point(10 + (1 * 20), 10 + (imagey * 20)) + "," + point(10 + (2 * 20), 10 + (imagey * 20)) + "," + point(10 + (3 * 20), 10 + (imagey * 20)) + "," + point(10 + (4 * 20), 10 + (imagey * 20)) + "," + point(10 + (5 * 20), 10 + (imagey * 20)) + "," + point(10 + (6 * 20), 10 + (imagey * 20)) + "," + point(10 + (7 * 20), 10 + (imagey * 20))
				next	
			_ENDSPOOL
		end if
	end if
	
	'			quit
	'
	if mx > 128 and mx < 159 and my > 175 and my <184 then
		COLOR 12: LOCATE 23, 17: PRINT "QUIT"
		if mb = 1 then
			_delay 1
			end
		end if
	end if
loop

Warning: May contain 'random features'... lol

Of course, the LPRINT and SPOOL commands may not be quite right - trial and error... lol

If I get some time tomorrow, I will try to modify or include a save letchr$() procedure... once I work it out... lol

Corrections, suggestions etc are welcomed and appreciated.
May your journey be free of incident.  Live long and prosper.

CharlieJV

That's pretty awesome.

Now I've just noticed something.  _MOUSEBUTTON returns a 1 when a button is pressed.

I'm thinking it would be more appropriate if it returned a -1 (i.e. TRUE), which would be more consistent with everything else in BAM.

What do you think?

CharlieJV

I'm going to lob a suggestion that's about how I like to organise code, but I hope you will quickly toss that aside if it does not fit at all your way of thinking.

My needs to organise (you would not think it looking at the disaster that is my house) stuff I see on screen would seem to border on extreme OCPD, but it is just about trying to keep the brain from getting overwhelmingly distracted and scattered.


I like to keep my blocks of code short and sweet to prevent scrolling.  That's just a way for me to manage the pains-in-the-caboose related to my cognitive disability(ies?).

If I were to take your code and refactor it, the guts of the program (i.e. the DO-WHILE-LOOP) would likely look like this:

do while inkey$ <> chr$(27)

    gosub AssignMouseFunctions

    gosub PlaceCurrentColourOnMainGrid
    gosub DisplayCurrentColour
    gosub UpdateSprite
    gosub EraseMainGridCellUnderMousePointer
    gosub ButtonTest
    gosub HandleNew
    gosub HandleSave
    gosub HandleQuit

loop

johnno56

Ah yes. Beautification. For me, that part of the job, I usually leave until I have the thing running without error. But, I am willing to forego tradition...

... as for the mouse button... as long as there is a difference between pressed and not pressed, whatever value that you need to use, I can work with that...

I slept in until 6am... I know... pitiful... I will make the changes later today
May your journey be free of incident.  Live long and prosper.

johnno56

I had a few spare moments between breakfast and leaving the house...

Something like this?

Screen 7: Cls

Dim GridA(8, 8)
Dim GridB(8, 8)

gosub Setup

do while Done <> true

    gosub UseMouse
    gosub DrawOnGrid
    gosub DisplayColour
    gosub UpdateSprite
    gosub EraseFromGrid
    gosub NewSprite
    gosub SaveSprite
    gosub Quit

loop
end

'			-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Setup:
		Done = false
    GridCol = 7
    EraseCol = 0
    currentColour = 7
    posX = 0
    posY = 0

    '		Draw Main Grid
    '
    for x = 0 to 140 step 20
    	for y = 0 to 140 step 20
    		line(x, y)-step(20, 20), GridCol, b
    	next
    next

    '		Draw Sample Grid
    '
    for imageX = 0 to 7
    	for imageY = 0 to 7
    		Line(224 + (imagex*4),16 + (imagey*4))-step(4,4),GridCol,b
    	next
    next

    '		Draw Current Colour Box
    line(234,60)-step(12, 12), GridCol, b

    '		Draw Colour Palette
    '
    for x = 1 to 5: line(190 + ((x - 1) * 20), 80)-step(20, 20), x, bf: next
    for x = 1 to 5: line(190 + ((x - 1) * 20), 100)-step(20, 20), x + 5, bf: next
    for x = 1 to 5: line(190 + ((x - 1) * 20), 120)-step(20, 20), x + 10, bf: next

    '		Draw Palette Grid
    '
    for x = 0 to 4
    	for y = 0 to 2
    		line(190 + (x * 20), 80 + (y * 20))-step(20, 20), GridCol, b
    	next
    next

    '       NewSaveQuit Buttons
    '
    LOCATE 23, 2: COLOR GridCol: PRINT "NEW"
    LOCATE 23, 9: COLOR GridCol: PRINT "SAVE"
    LOCATE 23, 17: COLOR GridCol: PRINT "QUIT"
Return

UseMouse:
    '       Assign mouse functions
	'
	mb = _mousebutton
	mx = _mousex
	my = _mousey
	
	'locate 1,1:COLOR 11: print using "MX: ###";mx
	'locate 2,1:COLOR 12: print using "MY: ###";my
	'locate 3,1:print using "MB: ###";mb
	'locate 4,1:print using "COL ###";currentColour
Return

DrawOnGrid:
    '
    '       PLACE CURRENT COLOUR ON MAIN GRID
    '
	if mb = 1 and mx > 0 and mx < 160 and my > 0 and my < 160 then
		paint(mx, my), currentColour, GridCol
	end if
Return

DisplayColour:
  '
	'       DISPLAY CURRENT COLOUR
	'
	if mb = 1 and mx > 190 and mx < 290 and my > 80 and my < 140 then
		currentColour = point(mx, my)
		line(234,60)-step(12, 12), currentColour, bf
	end if
	line(234,60)-step(12, 12), GridCol, b
Return

UpdateSprite:
  '	
	'   UPDATE SPRITE
	'
	for imageX = 0 to 7
		for imageY = 0 to 7
			GridB(posx,posy) = point(10 + (imagex * 20), 10 + (imagey * 20))
			Line(224 + (imagex*4),16 + (imagey*4))-step(4,4),GridB(posx,posy),bf
			Line(224 + (imagex*4),16 + (imagey*4))-step(4,4),GridCol,b
		next
	next
Return

EraseFromGrid:
  '		
	'		ERASE MAIN GRID CELL UNDER MOUSE POINTER
	'
	if inkey$ = " " and mx > 0 and mx < 160 and my > 0 and my < 160 and point(mx, my) <> GridCol then
		paint(mx, my), EraseCol, GridCol
	end if
Return

NewSprite:
  '	
	'       NEW
	'
	if mx > 8 and mx < 31 and my > 175 and my <184 then
		COLOR 10: LOCATE 23, 2: PRINT "NEW"
		if mb = 1 then
			for x = 0 to 140 step 20
				for y = 0 to 140 step 20
					line(x, y)-step(20, 20), 0, bf
					line(x, y)-step(20, 20), GridCol, b
				next
			next
		end if
	end if
Return

SaveSprite:
  '
	'       SAVE ??
	'
	if mx > 64 and mx <95 and my >175 and my < 184 then
		COLOR 11: LOCATE 23, 9: PRINT "SAVE"
		if mb =1 then
			_STARTSPOOL "BAM Data test.txt"
				LPRINT "SCREEN 7: CLS"
				LPRINT "DIM grid(8,8)"
				LPRINT "FOR y = 0 TO 7"
				LPRINT "   FOR x = 0 TO 7"
				LPRINT "      READ grid(x,y)"
				LPRINT "      PSET(x,y),grid(x,y)"
				LPRINT "   NEXT x"
				LPRINT "NEXT y"
				for imageY = 0 to 7
					LPRINT "DATA " + point(10 + (0 * 20), 10 + (imagey * 20)) + "," + point(10 + (1 * 20), 10 + (imagey * 20)) + "," + point(10 + (2 * 20), 10 + (imagey * 20)) + "," + point(10 + (3 * 20), 10 + (imagey * 20)) + "," + point(10 + (4 * 20), 10 + (imagey * 20)) + "," + point(10 + (5 * 20), 10 + (imagey * 20)) + "," + point(10 + (6 * 20), 10 + (imagey * 20)) + "," + point(10 + (7 * 20), 10 + (imagey * 20))
				next	
			_ENDSPOOL
		end if
	end if
Return

Quit:
  '
	'       QUIT
	'
	if mx > 128 and mx < 159 and my > 175 and my <184 then
		COLOR 12: LOCATE 23, 17: PRINT "QUIT"
		if mb = 1 then
			_delay 1
			Done = true
		end if
	end if
Return
'			-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

I have also organised each subroutine in the order in which they appear in the 'main loop'.

J
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on May 06, 2023, 08:43 PMAh yes. Beautification. For me, that part of the job, I usually leave until I have the thing running without error. But, I am willing to forego tradition...

... as for the mouse button... as long as there is a difference between pressed and not pressed, whatever value that you need to use, I can work with that...

I slept in until 6am... I know... pitiful... I will make the changes later today

Arg!  I wish I would have gotten back to you earlier.  It just dawned on me after reading your reply: I do the exact same thing: so hyper-focused on just getting my own programs to work, my code is often caboose-ugly.

Then again, when the code does start getting really long and I start having a hard time finding what I'm looking for, likely trying to resolve a bug, the I do go into refactoring/structuring mode.

Looking at your altered code, it is some easy to see the big picture and where to look for details.

That's some frigging nice!

Oh, 2nd period of the hockey game has started!  Eyeballs back to tv !