Qbasicnews.com

Pages: 1 2

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!

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

... 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...

You arn't sharing XPos%
You are sharing XPos%(1 TO 16)

Oh.. now I see... :oops: Thanks for the help! :bounce:

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

I recommend wrap-around walls.

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

Sure I will add the load feature, and a feature to create and load sprites with different size Smile

By the way, good modification of the code Smile

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

Pages: 1 2

Eurodance

Mac

Eurodance

whitetiger0990

Eurodance

Eurodance

Meg

Mac

Eurodance

Eurodance