REM SPRITEEDITOR
DIM f(40, 40)
x1! = 200: y1! = 20: x2! = 219: y2! = 39
gr% = 4 + INT(((x2! - x1! + 1) * (1) + 7) / 8) * 4 * (y2! - y1! + 1)
DIM sprite%(1 TO gr%)
:
SCREEN 7
COLOR 15, 0: CLS
PRINT "######################"
FOR x = 1 TO 20
PRINT "#                    #"
NEXT x
PRINT "######################"
:
LINE (199, 19)-(220, 40), 15, B
:
COLOR 15, 0
LOCATE 1, 24: PRINT "Your Color:"
col = 15: GOSUB drawcol
LOCATE 13, 23: PRINT " Usage:"
COLOR 14
LOCATE 15, 23: PRINT " <D>    freedraw"
LOCATE 16, 23: PRINT " <S>    to save"
LOCATE 17, 23: PRINT " <E>    to export"
LOCATE 18, 23: PRINT " <L>    to load"
LOCATE 19, 23: PRINT " <C>    to clear"
LOCATE 20, 23: PRINT " <+->   colors"
LOCATE 21, 23: PRINT " <Del>  del point"
LOCATE 22, 23: PRINT " <Q>    to quiet";
:
COLOR 15, 0
posx = 1: posy = 1: col = 15
GOSUB loesch
jetztet:
        LOCATE posy + 1, posx + 1
        c = f(posx, posy): IF c = 0 THEN c = 15
        COLOR c, 0: PRINT CHR$(177);
        :
drawer:
        a$ = INKEY$
neumal:
        IF a$ <> "" THEN LOCATE posy + 1, posx + 1: COLOR f(posx, posy), 0: PRINT CHR$(219);
        IF a$ = CHR$(0) + "M" THEN posx = posx + 1: IF posx > 20 THEN posx = 20
        IF a$ = CHR$(0) + "K" THEN posx = posx - 1: IF posx < 1 THEN posx = 1
        IF a$ = CHR$(0) + "H" THEN posy = posy - 1: IF posy < 1 THEN posy = 1
        IF a$ = CHR$(0) + "P" THEN posy = posy + 1: IF posy > 20 THEN posy = 20
        LOCATE 23, 1: PRINT "X:"; posx; " Y:"; posy; "  "
        IF a$ = "q" OR a$ = CHR$(27) THEN STOP
        IF a$ = "c" THEN RUN
        IF a$ = "s" THEN GOTO save
        IF a$ = "l" THEN GOTO load
        IF a$ = CHR$(0) + "S" THEN f(posx, posy) = 0: PSET (199 + posx, 19 + posy), 0
        IF a$ = " " OR dr = 1 THEN f(posx, posy) = col: PSET (199 + posx, 19 + posy), col
        IF a$ = "+" THEN col = col + 1: IF col > 15 THEN col = 0
        IF a$ = "-" THEN col = col - 1: IF col < 0 THEN col = 15
        IF a$ = "+" OR a$ = "-" THEN GOSUB drawcol
        IF a$ = "d" AND dr = 1 THEN COLOR 15, 0: dr = 0: a$ = "": LOCATE 1, 6: PRINT "#############";
        IF a$ = "d" AND dr = 0 THEN COLOR 14, 0: dr = 1: LOCATE 1, 6: PRINT " FREEDRAW ON ";
        IF a$ = "*" THEN winkel = winkel + 5: GOSUB drehe
        IF a$ = "_" THEN winkel = winkel - 5: GOSUB drehe
        IF a$ = "e" THEN GOTO export
        IF a$ = "t" THEN GOTO take
        IF a$ = "m" THEN GOSUB mirror
        GOTO jetztet
        :
drawcol:
        LINE (189, 8)-(190 + 85, 17), 0, BF
        FOR x = 0 TO 15
        LINE (190 + x * 5, 9)-(193 + x * 5, 16), x, BF
        IF x = col THEN LINE (189 + x * 5, 8)-(194 + x * 5, 17), 15, B
        NEXT x
        RETURN
        :
save:
        GOSUB loesch
        GET (200, 20)-(219, 39), sprite%
        PUT (230, 20), sprite%, PSET
        COLOR 15, 0
        LOCATE 7, 24: PRINT "Name:"
        LOCATE 8, 24: INPUT name$
        IF name$ = "" THEN GOTO jetztet
        OPEN name$ FOR OUTPUT AS #1
        WRITE #1, 20, 20: REM xgr,ygr
        WRITE #1, gr%: REM anzahl
        FOR x = 1 TO gr%
                WRITE #1, sprite%(x)
        NEXT x
        CLOSE #1
        GOTO jetztet
        :
load:
        COLOR 15, 0
        GOSUB loesch
        LOCATE 7, 24: PRINT "name:"
        LOCATE 8, 24: INPUT name$
        IF name$ = "" THEN GOTO jetztet
        OPEN name$ FOR INPUT AS #1
        INPUT #1, xa, ya
        INPUT #1, gr%: REM anzahl
        FOR x = 1 TO gr%
                INPUT #1, sprite%(x)
        NEXT x
        CLOSE #1
        LINE (200, 20)-(219, 39), 0, BF
        PUT (200, 20), sprite%, PSET
        FOR x = 1 TO 20: FOR y = 1 TO 20
                c = POINT(199 + x, 19 + y)
                f(x, y) = c: COLOR c, 0
                LOCATE 1 + y, 1 + x: PRINT CHR$(219);
        NEXT y: NEXT x
        GOTO jetztet
        :
drehe:
        COLOR 15
        LOCATE 7, 24: PRINT winkel; "degree"
        LOCATE 8, 24: PRINT "<T> to take"
        REM degrees to rotate in variable winkel
        winkel2 = (3.1415 / 180) * winkel: REM calculate degree ro rad
        ofsx = 200: ofsy = 20: REM offset original object
        newx = 230: newy = 20: REM offset rotated object
        cosin = COS(winkel2)
        sinus = SIN(winkel2)
        FOR x = 0 TO 19
                FOR y = 0 TO 19
                        c = POINT(ofsx + x, ofsy + y)
                        xb = x - 10: yb = y - 10
                        xa = xb * cosin + yb * sinus
                        ya = -xb * sinus + yb * cosin
                        PSET (xa + newx + 10, ya + newy + 10), c
                NEXT y
        NEXT x
        GOSUB loesch
        RETURN
        :
export:
        GOSUB loesch
        GET (200, 20)-(219, 39), sprite%
        PUT (230, 20), sprite%
        COLOR 15, 0
        LOCATE 7, 24: PRINT "locator:"
        LOCATE 8, 24: INPUT loc$
        IF loc$ = "" THEN GOTO jetztet
        LOCATE 7, 24: PRINT "filename:"
        LOCATE 8, 24: PRINT "              ": LOCATE 8, 24: INPUT name$
        IF name$ = "" THEN GOTO jetztet
askagain:
        OPEN name$ FOR RANDOM AS #1
        u$ = "o"
        IF LOF(1) > 10 THEN LOCATE 7, 24: PRINT "(a)pp or (n)ew:": LOCATE 8, 24: PRINT "               ": LOCATE 8, 24: INPUT u$
        CLOSE #1
        u$ = UCASE$(u$)
        IF u$ = "" THEN GOSUB loesch: GOTO jetztet
        IF u$ = "N" THEN OPEN name$ FOR OUTPUT AS #1
        IF u$ = "A" THEN OPEN name$ FOR APPEND AS #1
        IF u$ <> "A" AND u$ <> "N" THEN BEEP: GOTO askagain
        t$ = CHR$(9)
        PRINT #1, CHR$(13)
        PRINT #1, t$ + "REM *** SPRITE-ED ***"
        PRINT #1, t$ + ":"
        PRINT #1, t$ + "RESTORE " + loc$ + "data"
        PRINT #1, t$ + "DIM " + loc$ + "%(1 TO" + STR$(gr%) + ")"
        PRINT #1, t$ + "FOR sprite=1 TO" + STR$(gr%)
        PRINT #1, t$ + t$ + "read " + loc$ + "%(sprite)"
        PRINT #1, t$ + "NEXT sprite"
        PRINT #1, t$ + ":"
        PRINT #1, loc$ + "data:";
        y = 0
        FOR x = 1 TO gr%
                y = y + 1: IF y = 1 THEN PRINT #1, "": PRINT #1, t$ + "DATA ";
                PRINT #1, STR$(sprite%(x));
                IF y = 24 THEN y = 0 ELSE IF x <> gr% THEN PRINT #1, ",";
        NEXT x
        CLOSE #1
        GOSUB loesch
        GOTO jetztet
        :
loesch:      
        FOR x = 7 TO 11: LOCATE x, 23: PRINT "                "
        NEXT x
        LINE (199, 19)-(220, 40), 15, B
        LINE (229, 19)-(250, 40), 15, B
        RETURN
        :     
take:
        GET (230, 20)-(230 + 20, 20 + 20), sprite%
        PUT (200, 20), sprite%, PSET
        FOR x = 1 TO 20: FOR y = 1 TO 20
                c = POINT(229 + x, 19 + y)
                f(x, y) = c: COLOR c, 0
                LOCATE 1 + y, 1 + x: PRINT CHR$(219);
        NEXT y: NEXT x
        GOSUB loesch
        GOTO jetztet
        :
mirror:
        FOR x = 1 TO 20: FOR y = 1 TO 20
                c = POINT(199 + x, 19 + y)
                f(21 - x, y) = c: COLOR c, 0
                LOCATE 1 + y, 1 + 21 - x: PRINT CHR$(219);
        NEXT y: NEXT x
        FOR x = 1 TO 20: FOR y = 1 TO 20
                c = f(x, y)
                PSET (199 + x, 19 + y), c
        NEXT y: NEXT x
        RETURN