Posts: 42
Threads: 6
Joined: Dec 2004
DECLARE SUB PsetThere ()
DECLARE SUB Update (WhatToUpdate)
'EGA Sprite Editor - 16x16 Sprites
SCREEN 7
DIM SHARED Sprite%(1 TO 66)
DIM SHARED XPos%(1 TO 16)
DIM SHARED YPos%(1 TO 16)
DIM SHARED X%, Y%, iX%, iY%
DIM SHARED Colour%
XPos% = 1: YPos% = 1
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
Colour% = 7
PAINT (0, 0), 1
FOR B% = 10 TO 42 STEP 2
FOR a% = 10 TO 42 STEP 2
PSET (a% + 1, B% + 1), 7
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), 7
NEXT a%
NEXT B%
LINE (49, 10)-(67, 28), 15, B
Update 1
Update 2
WHILE INKEY$ = "": WEND
SUB Update (WhatToUpdate)
IF WhatToUpdate = 1 THEN
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
LINE (X%, Y%)-(X% + 2, Y% + 2), 4, B
ELSE
LOCATE 1, 18: COLOR Colour%, 0: PRINT "COLOUR"
END IF
END SUB
------------------------------------------------------------------
I'm trying to make a sprite editor to help me making the sprites
for a game, but something is wrong... Check it, and see where the Selector goes... What's wrong here? Maybe a qbasic bug or what? Or I did an error? Please help!
EEL THE BEAT OF EURODANCE!!!
Posts: 243
Threads: 12
Joined: Aug 2001
Hi, Eurodance,
You initialize some stuff and then do
WHILE INKEY$ = "": WEND
but nothing else and so the program terminates.
What did you expect to happen that didn't?
Mac
Posts: 42
Threads: 6
Joined: Dec 2004
... did you saw what's the problem? It's not that the program stops, I made it to stop, because it's not completed. I'm writting it now. The problem is that I set XPos% and YPos% = 1, and in Update folder they are = 0...
EEL THE BEAT OF EURODANCE!!!
Posts: 2,765
Threads: 138
Joined: Nov 2002
You arn't sharing XPos%
You are sharing XPos%(1 TO 16)
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 42
Threads: 6
Joined: Dec 2004
Oh.. now I see... :oops: Thanks for the help! :bounce:
EEL THE BEAT OF EURODANCE!!!
Posts: 42
Threads: 6
Joined: Dec 2004
The sprite editor is completed, here is the source, so everyone can use it. Note that it works only with 16 x 16 pixels sprites in Screen 7.
DECLARE SUB FillIt ()
DECLARE SUB ClearIt ()
DECLARE SUB SaveSprite ()
DECLARE SUB DelSel ()
DECLARE SUB PsetThere ()
DECLARE SUB Update (WhatToUpdate)
'EGA Sprite Editor - 16x16 Sprites
DIM SHARED Sprite%(1 TO 66)
DIM SHARED XPos%, YPos%, X%, Y%, iX%, iY%, Colour%
DIM SHARED SpriteName$
CLS
Begining:
INPUT "Sprite name: ", SpriteName$
SCREEN 7
XPos% = 1: YPos% = 1
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
Colour% = 0
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), 7
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), 7
NEXT a%
NEXT B%
LINE (9, 9)-(43, 43), 15, B
LINE (49, 10)-(66, 27), 15, B
Update 1
Update 2
DO
Pressed$ = INKEY$
SELECT CASE UCASE$(Pressed$)
CASE "D": IF XPos% < 16 THEN DelSel: XPos% = XPos% + 1: Update 1
CASE "A": IF XPos% > 1 THEN DelSel: XPos% = XPos% - 1: Update 1
CASE "W": IF YPos% > 1 THEN DelSel: YPos% = YPos% - 1: Update 1
CASE "S": IF YPos% < 16 THEN DelSel: YPos% = YPos% + 1: Update 1
CASE " ": PsetThere
CASE "`": Colour% = 0: Update 2
CASE "1": Colour% = 1: Update 2
CASE "2": Colour% = 2: Update 2
CASE "3": Colour% = 3: Update 2
CASE "4": Colour% = 4: Update 2
CASE "5": Colour% = 5: Update 2
CASE "6": Colour% = 6: Update 2
CASE "7": Colour% = 7: Update 2
CASE "8": Colour% = 8: Update 2
CASE "9": Colour% = 9: Update 2
CASE "0": Colour% = 10: Update 2
CASE "-": Colour% = 11: Update 2
CASE "=": Colour% = 12: Update 2
CASE "\": Colour% = 13: Update 2
CASE "Q": Colour% = 14: Update 2
CASE "E": Colour% = 15: Update 2
CASE CHR$(27): GOTO Bye
CASE CHR$(13): SaveSprite
CASE "R": SCREEN 0: WIDTH 80, 25: GOTO Begining
CASE "C": ClearIt
CASE "F": FillIt
END SELECT
LOOP
Bye:
SCREEN 0: WIDTH 80, 25
END
SUB ClearIt
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), 7
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), 7
NEXT a%
NEXT B%
END SUB
SUB DelSel
LINE (X%, Y%)-(X% + 2, Y% + 2), 0, B
END SUB
SUB FillIt
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), Colour%
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), Colour%
NEXT a%
NEXT B%
END SUB
SUB PsetThere
PSET (X% + 1, Y% + 1), Colour%
PSET (iX%, iY%), Colour%
END SUB
SUB SaveSprite
GET (50, 11)-(65, 26), Sprite%
DEF SEG = VARSEG(Sprite%(1))
BSAVE SpriteName$ + ".spr", 0, 132
DEF SEG
END SUB
SUB Update (WhatToUpdate)
IF WhatToUpdate = 1 THEN
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
LINE (X%, Y%)-(X% + 2, Y% + 2), 4, B
ELSE
LOCATE 1, 18: COLOR 15: PRINT "COLOUR: "; : COLOR Colour%: PRINT CHR$(219)
END IF
END SUB
EEL THE BEAT OF EURODANCE!!!
Posts: 480
Threads: 24
Joined: Mar 2003
I recommend wrap-around walls.
Posts: 243
Threads: 12
Joined: Aug 2001
Hi, Eurodance,
Nice editor. I had some problems figuring out what to do, but examined code and put in some prompts for the user. I also changed it to only prompt for spritename if the user actually wants to save.
I don't use sprites, so am unfamiliar with the feasibility of this, but I suggest you add a feature to load an existing sprite so the user can take one that was created before and then load it and patch it.
Mac
Code: DECLARE SUB Update (WhatToUpdate!)
DECLARE SUB DelSel (P%, n%)
DECLARE SUB PsetThere ()
DECLARE SUB ClearIt ()
DECLARE SUB FillIt ()
DECLARE SUB SaveSprite ()
' EGA Sprite Editor - 16x16 Sprites
DIM SHARED Sprite%(1 TO 66)
DIM SHARED XPos%, YPos%, X%, Y%, iX%, iY%, Colour%
CLS
Begining:
SCREEN 7
XPos% = 1: YPos% = 1
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
Colour% = 0
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), 7
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), 7
NEXT a%
NEXT B%
LINE (9, 9)-(43, 43), 15, B
LINE (49, 10)-(66, 27), 15, B
Update 1
Update 2
CONST Colours = "`1234567890-=\QE"
COLOR 7, 0
LOCATE 8, 1: PRINT "Colours: "; Colours$
LOCATE , 10
FOR i = 1 TO LEN(Colours)
COLOR i - 1: PRINT "X";
NEXT i
COLOR 7: PRINT
PRINT : PRINT "Arrow keys or DAWS to move cursor"
PRINT : PRINT "Spacebar to change pixel"
PRINT : PRINT "ESC to optionally save and/or exit"
PRINT : PRINT "R=restart C=clear F=fill"
AU$ = CHR$(0) + "H"
AD$ = CHR$(0) + "P"
aL$ = CHR$(0) + "K"
aR$ = CHR$(0) + "M"
DO
DO: Pressed$ = INKEY$: LOOP WHILE Pressed$ = ""
v% = INSTR("`1234567890-=\QE", UCASE$(Pressed$))
IF v% > 0 THEN
Colour% = v% - 1: Update 2
ELSE
SELECT CASE UCASE$(Pressed$)
CASE "D", aR$: IF XPos% < 16 THEN DelSel XPos%, 1
CASE "A", aL$: IF XPos% > 1 THEN DelSel XPos%, -1
CASE "W", AU$: IF YPos% > 1 THEN DelSel YPos%, -1
CASE "S", AD$: IF YPos% < 16 THEN DelSel YPos%, 1
CASE " ": PsetThere
CASE CHR$(27): GOSUB Bye
CASE "R": SCREEN 0: WIDTH 80, 25: GOTO Begining
CASE "C": ClearIt
CASE "F": FillIt
END SELECT
END IF
LOOP
STOP: ' Never gets here
Bye:
COLOR 7, 0
P$ = "Save Sprite": GOSUB GetAns
IF Ans$ = "Y" THEN CALL SaveSprite
P$ = "Terminate run": GOSUB GetAns
IF Ans$ = "N" THEN COLOR Colour%: RETURN
SCREEN 0: WIDTH 80, 25
SYSTEM
GetAns:
LOCATE 20, 1, 1: PRINT P$; "? Y/N: ";
DO
DO: k$ = INKEY$: LOOP WHILE k$ = ""
Ans$ = UCASE$(k$)
LOOP WHILE INSTR("YN", Ans$) = 0
LOCATE 20, 1: PRINT SPACE$(30);
RETURN
SUB ClearIt
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), 7
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), 7
NEXT a%
NEXT B%
END SUB
SUB DelSel (P%, n%)
P% = P% + n%
LINE (X%, Y%)-(X% + 2, Y% + 2), 0, B
Update 1
END SUB
SUB FillIt
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), Colour%
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), Colour%
NEXT a%
NEXT B%
END SUB
SUB PsetThere
PSET (X% + 1, Y% + 1), Colour%
PSET (iX%, iY%), Colour%
END SUB
SUB SaveSprite
GET (50, 11)-(65, 26), Sprite%
DEF SEG = VARSEG(Sprite%(1))
LOCATE 20, 1: INPUT "Sprite name: ", SpriteName$
BSAVE SpriteName$ + ".spr", 0, 132
DEF SEG
END SUB
SUB Update (WhatToUpdate)
IF WhatToUpdate = 1 THEN
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
LINE (X%, Y%)-(X% + 2, Y% + 2), 4, B
ELSE
LOCATE 1, 18: COLOR 15: PRINT "COLOUR: "; : COLOR Colour%: PRINT CHR$(219)
END IF
END SUB
Posts: 42
Threads: 6
Joined: Dec 2004
Sure I will add the load feature, and a feature to create and load sprites with different size
By the way, good modification of the code
EEL THE BEAT OF EURODANCE!!!
Posts: 42
Threads: 6
Joined: Dec 2004
Loading added:
Code: DECLARE SUB CreateNew ()
DECLARE SUB Update (WhatToUpdate!)
DECLARE SUB DelSel (P%, n%)
DECLARE SUB PsetThere ()
DECLARE SUB ClearIt ()
DECLARE SUB FillIt ()
DECLARE SUB SaveSprite ()
DIM SHARED Sprite%(1 TO 66)
DIM SHARED XPos%, YPos%, X%, Y%, iX%, iY%, Colour%
CLS
Begining:
COLOR 15
PRINT "Press: O to open an existing sprite"
PRINT " N to create a new sprite"
PRINT " D to view the current directory's content"
PRINT " Q to terminate the program": LOCATE 1, 1, 0
DO
DO: keyb$ = INKEY$: LOOP WHILE keyb$ = ""
Ans$ = UCASE$(keyb$)
LOOP WHILE INSTR("ONDQ", UCASE$(keyb$)) = 0
IF Ans$ = "D" THEN CLS : SHELL "dir /w": PRINT : GOTO Begining
IF Ans$ = "Q" THEN PRINT : SYSTEM
IF Ans$ = "O" THEN GOSUB OpenSprite ELSE CreateNew
XPos% = 1: YPos% = 1
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
Colour% = 0
LINE (9, 9)-(43, 43), 15, B
LINE (49, 10)-(66, 27), 15, B
Update 1
Update 2
CONST Colours = "`1234567890-=\QE"
COLOR 15, 0: LOCATE 8, 1: PRINT "Colours: "; Colours$
LOCATE , 10
FOR i = 1 TO LEN(Colours)
COLOR i - 1: PRINT CHR$(219);
NEXT i
COLOR 14: PRINT
PRINT : PRINT "Arrow keys or DAWS to move cursor"
PRINT : PRINT "Spacebar to change pixel"
PRINT : PRINT "ESC to optionally save and/or exit"
PRINT : PRINT "R: Restart / C: Clear / F: Fill"
AU$ = CHR$(0) + "H"
AD$ = CHR$(0) + "P"
AL$ = CHR$(0) + "K"
AR$ = CHR$(0) + "M"
DO
DO: Pressed$ = INKEY$: LOOP WHILE Pressed$ = ""
v% = INSTR("`1234567890-=\QE", UCASE$(Pressed$))
IF v% > 0 THEN
Colour% = v% - 1: Update 2
ELSE
SELECT CASE UCASE$(Pressed$)
CASE "D", AR$: IF XPos% < 16 THEN DelSel XPos%, 1
CASE "A", AL$: IF XPos% > 1 THEN DelSel XPos%, -1
CASE "W", AU$: IF YPos% > 1 THEN DelSel YPos%, -1
CASE "S", AD$: IF YPos% < 16 THEN DelSel YPos%, 1
CASE " ": PsetThere
CASE CHR$(27): GOSUB Bye
CASE "R": SCREEN 0: WIDTH 80, 25: GOTO Begining
CASE "C": ClearIt
CASE "F": FillIt
END SELECT
END IF
LOOP
Bye:
COLOR 15, 0
P$ = "Save sprite": GOSUB GetAns
IF Ans$ = "Y" THEN SaveSprite
P$ = "Terminate run": GOSUB GetAns
IF Ans$ = "N" THEN COLOR Colour%: RETURN
SCREEN 0: WIDTH 80, 25
SYSTEM
GetAns:
LOCATE 20, 1, 1: PRINT P$; "? (Y/N) ";
DO
DO: k$ = INKEY$: LOOP WHILE k$ = ""
Ans$ = UCASE$(k$)
LOOP WHILE INSTR("YN", Ans$) = 0
LOCATE 20, 1: PRINT SPACE$(30);
RETURN
OpenSprite:
CLS : PRINT "File to open (include extension): "; : INPUT "", f$
ON ERROR GOTO ErrorHandler
DEF SEG = VARSEG(Sprite%(1))
BLOAD f$, 0
DEF SEG
SCREEN 7
PUT (50, 11), Sprite%, PSET
ON ERROR GOTO 0
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), POINT(((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11)
NEXT a%
NEXT B%
RETURN
ErrorHandler:
IF ERR = 53 THEN PRINT "File not found...": PRINT : SYSTEM
IF ERR = 5 THEN SCREEN 0: WIDTH 80, 25: COLOR 15: PRINT "Invalid sprite file, terminating the program": SYSTEM
SUB ClearIt
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), 7
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), 7
NEXT a%
NEXT B%
END SUB
SUB CreateNew
SCREEN 7
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), 7
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), 7
NEXT a%
NEXT B%
END SUB
SUB DelSel (P%, n%)
P% = P% + n%
LINE (X%, Y%)-(X% + 2, Y% + 2), 0, B
Update 1
END SUB
SUB FillIt
FOR B% = 10 TO 40 STEP 2
FOR a% = 10 TO 40 STEP 2
PSET (a% + 1, B% + 1), Colour%
PSET (((a% - 10) / 2) + 50, ((B% - 10) / 2) + 11), Colour%
NEXT a%
NEXT B%
END SUB
SUB PsetThere
PSET (X% + 1, Y% + 1), Colour%
PSET (iX%, iY%), Colour%
END SUB
SUB SaveSprite
GET (50, 11)-(65, 26), Sprite%
DEF SEG = VARSEG(Sprite%(1))
LOCATE 20, 1: INPUT "Sprite name: ", SpriteName$
BSAVE SpriteName$ + ".spr", 0, 132
DEF SEG
END SUB
SUB Update (WhatToUpdate)
IF WhatToUpdate = 1 THEN
X% = 10 + ((XPos% - 1) * 2)
Y% = 10 + ((YPos% - 1) * 2)
iX% = 49 + XPos%: iY% = 10 + YPos%
LINE (X%, Y%)-(X% + 2, Y% + 2), 4, B
ELSE
LOCATE 1, 18: COLOR 15: PRINT "COLOUR: "; : COLOR Colour%: PRINT CHR$(219)
END IF
END SUB
EEL THE BEAT OF EURODANCE!!!
|