10 ' ********************************************
20 ' * Sprite Generator Written By Jason Brooks *
30 ' * Converted from the ARCHIMEDES by myself. *
40 ' * Conversion Started on 23rd September '89 *
50 ' ********************************************
60 '
70 ' Ensure 2 K Buffer
80 'OPENOUT"dummy":MEMORY HIMEM-1:CLOSEOUT
90 ' Initialize Variables
100 DEFINT a-z:DIM col(15,2):down$=CHR$(10)+CHR$(10):template$="0123456789":l=1:k=1:m=50:block$=CHR$(24)+" "+CHR$(24):boxy=0:brush=1:block1$=CHR$(24)+"*"+CHR$(24)
110 opp=1:opp1=1
120 cursor.left=8:cursor.right=1:cursor.down=2:cursor.up=0:spray=21:colour.left=71:colour.right=63:sprite.save=60:sprite.load=36:sprite.clear=16
130 cut=68:toggle.spr.box=51:toggle.grid=43:paste=27
140 ' Set Up Screen Mode & Colours
150 '
160 'CALL &BBFF:CALL &BC02:MODE 1:BORDER 0:INK 0,0
170 MODE 2:PRINT"Which Mode Do You Wish To Design Your Sprites In ? ";:GOSUB 540:md=VAL(b$):IF md>2 THEN 170
180 l=2:x=md*20+16:mo=2^(2-md)
190 ' Select Sprite Grid Size
200 CLS:LOCATE 1,1:PRINT"Enter Grid Size":PRINT:PRINT"Maximum = ";m:LOCATE 1,5:PRINT"X - Length =   ";CHR$(8);CHR$(8);:GOSUB 540:gridx=VAL(b$):IF gridx>m OR gridx<1 THEN 200
210 LOCATE 1,7:PRINT"Y - Length =   ";CHR$(8);CHR$(8);:GOSUB 540:gridy=VAL(b$):IF gridy>m OR gridy<1 THEN 210
220 ' Set Up Array For Sprite Cell
230 '
240 DIM sprite(gridx,gridy),paste(gridx,gridy)
250 ' Set Up Pallette
260 '
270 FOR i=0 TO 15:col(i,1)=i:col(i,2)=i:NEXT
280 col=2^(mo)-1:template1$=LEFT$("0123456789ABCDEF",col+1)
290 GOSUB 1560
300 boxx=gridx*lx+(2*mo)
310 IF set=1 THEN GOSUB 1580
320 GOSUB 1530
330 GOSUB 1820
340 bx=gridx/2:by=gridy/2
350 GOSUB 870
360 ' Un-Draw Cursor
370 '
380 IF INKEY(cursor.left)>-1 THEN bx=bx-1:IF bx=0 THEN bx=gridx
390 IF INKEY(cursor.right)>-1 THEN bx=bx+1:IF bx=gridx+1 THEN bx=1
400 IF INKEY(cursor.up)>-1 THEN by=by+1:IF by=gridy+1 THEN by=1
410 IF INKEY(cursor.down)>-1 THEN by=by-1:IF by=0 THEN by=gridy
420 IF INKEY(spray)>-1 THEN GOSUB 980
430 IF INKEY(sprite.load)>-1 THEN 1620
440 IF INKEY(sprite.save)>-1 THEN GOTO 1220
450 IF INKEY(sprite.clear)>-1 THEN GOSUB 1450
460 IF INKEY(colour.left)>-1 THEN i=1:GOSUB 1180
470 IF INKEY(colour.right)>-1 THEN i=2:GOSUB 1180
480 IF INKEY(cut)>-1 THEN cx=bx:cy=by:cutf=1:LOCATE 1,3:PRINT"Function = CUT"
490 IF INKEY(toggle.spr.box)>-1 THEN opp1=opp1 XOR 1:GOSUB 1820
500 IF INKEY(toggle.grid)>-1 THEN opp=opp XOR 1:GOSUB 1570
501 IF INKEY(paste)>-1 THEN GOSUB 5000
510 GOSUB 760:GOSUB 1100
520 ' Draw Cursor & Brush Change ?
530 GOTO 350
540 ' Input Routine: Exits With String Variable 'b' With Chars typed
550 ' Enter with variable 'l' for length of string required
560 ' And enter with variable 'template' for stencil required
570 '
580 b$=""
590 a$=UPPER$(INKEY$):IF a$="" THEN 590
600 IF a$=CHR$(13) THEN numb=VAL(b$):RETURN
610 IF a$=CHR$(127) THEN GOSUB 650
620 IF INSTR(template$,a$)=0 THEN 590
630 IF LEN(b$)=l THEN RETURN
640 b$=b$+a$:PRINT a$;:GOTO 590
650 ' Delete Character From B$ If Possible And Delete Character From Screen.
660 ' Routine uses variable 'a' for calculations
670 '
680 IF b$="" THEN RETURN
690 a=LEN(b$):IF a=1 THEN b$="":GOTO 710
700 a=a-1:b$=LEFT$(b$,a)
710 PRINT CHR$(8);CHR$(32);CHR$(8);:RETURN
720 ' Display A Slab Of Colour
730 ' Display The Pen Number In Hex.
740 LOCATE i+1,1:PEN i:PRINT block$;:PEN 1:LOCATE i+1,2:PRINT HEX$(i);:IF brush=i THEN PEN brush:LOCATE i+1,1:PRINT block1$;
750 RETURN
760 ' Draw Cursor
770 cbrush=cbrush+1:IF cbrush>13 THEN cbrush=2
780 IF cutf<>0 THEN 800
790 MOVE (bx-1)*lx,(by-1)*ly:DRAWR lx,0,cbrush:DRAWR 0,ly:DRAWR -lx,0:DRAWR 0,-ly:RETURN
800 MOVE (cx-1)*lx,(cy-1)*ly
810 opp2=cbrush
820 IF (cx<bx OR cx=bx) AND (cy<by OR cy=by) THEN 1980
830 IF cx<bx OR cx=bx AND cy>by THEN 2040
840 IF bx<cx AND (by>cy OR by=cy) THEN 2100
850 IF bx<cx AND by<cy THEN 2160
860 RETURN
870 ' Un-Draw Cursor
880 '
890 IF cutf<>0 THEN 910
900 MOVE (bx-1)*lx,(by-1)*ly:DRAWR lx,0,opp:DRAWR 0,ly:DRAWR -lx,0:DRAWR 0,-ly:RETURN
910 MOVE (cx-1)*lx,(cy-1)*ly
920 opp2=opp1
930 IF (cx<bx OR cx=bx) AND (cy<by OR cy=by) THEN 1980
940 IF cx<bx OR cx=bx AND cy>by THEN 2040
950 IF bx<cx AND (by>cy OR by=cy) THEN 2100
960 IF bx<cx AND by<cy THEN 2160
970 RETURN
980 ' Toggle Block On Screen.
990 '
1000 IF cutf=1 THEN 1840
1010 sprite(bx,by)=brush
1020 height=(by+1)*ly-(by*ly)-4
1030 length=(bx+1)*lx-(bx*lx)-(2*mo)
1040 fx=(bx-1)*lx+mo:fy=(by-1)*ly+2
1050 FOR i=0 TO height
1060 MOVE fx,fy+i:DRAWR length,0,brush
1070 NEXT
1080 PLOT boxx+(bx*mo),boxy+(by*2),brush
1090 RETURN
1100 'Does User Wish to Alter Brush
1110 '
1120 a$=UPPER$(INKEY$):IF a$="" THEN RETURN
1130 IF INSTR(template1$,a$)=0 THEN RETURN
1140 LOCATE brush+1,1:PEN brush:PRINT block$;:brush=VAL("&"+a$):i=brush:GOSUB 740:PEN 1
1150 'Clear Key Board Buffer
1160 '
1170 WHILE INKEY$<>"":WEND:RETURN
1180 'Cycle through current ink selected if user wishes.
1190 '
1200 a=col(brush,i):a=a+1:IF a=27 THEN a=0
1210 col(brush,i)=a:INK brush,col(brush,1),col(brush,2):RETURN
1220 ' Save Sprite Data, Ink Values And Mode Routine.
1230 '
1240 MODE 1:PEN 1:INK 1,26:INK 0,0:PAPER 0:CLS
1250 template$="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.-:"
1260 l=16
1270 PRINT"Please Enter File Name To Save Data":PRINT:PRINT"> ";
1280 GOSUB 1150
1290 GOSUB 580
1300 MODE 1:PRINT"Thank you. SAVEing :";b$
1310 OPENOUT b$
1320 ' Write Sprite Mode
1330 WRITE #9,md
1340 ' Write Size Of Matrix
1350 WRITE #9,gridx,gridy
1360 ' Write Ink Values
1370 FOR i=0 TO 15:WRITE #9,col(i,1),col(i,2):NEXT
1380 ' Write Sprite Data
1390 wri$=""
1400 FOR i=1 TO gridx:FOR t=1 TO gridy
1410 wri$=wri$+HEX$(sprite(i,t),1):NEXT t:WRITE#9,wri$:wri$="":NEXT i
1420 ' Close Down Sprite File
1430 CLOSEOUT
1440 MODE md:GOTO 290
1450 'Clear Grid Routine:
1460 GOSUB 1150:LOCATE 1,3:PEN 1:PRINT"Are You Sure ?"
1470 GOSUB 1780:LOCATE 1,3:PRINT SPACE$(15);:IF an=0 THEN RETURN
1480 FOR i=0 TO gridy*ly:MOVE 0,i:DRAW gridx*lx,i,brush:NEXT:GOSUB 1570
1490 FOR i=1 TO gridy:MOVE boxx+mo,i*2:DRAW boxx+(mo*gridx),i*2,brush:NEXT
1500 FOR i=1 TO gridx:FOR t=1 TO gridy
1510 sprite(i,t)=brush:NEXT t,i
1520 RETURN
1530 ' Set Inks To Ones In Array COL
1540 FOR i=0 TO col:GOSUB 720:INK i,col(i,1),col(i,2):NEXT:RETURN
1550 'Set Mode & Calculate offsets
1560 MODE md:ORIGIN 0,0:MOVE 0,0:ly=INT(336/gridy) AND 510:lx=INT(399/gridx) AND 510:lx=lx+(lx MOD mo)
1570 FOR i=0 TO gridy:MOVE 0,i*ly:DRAW gridx*lx,i*ly,opp:NEXT:FOR i=0 TO gridx:MOVE i*lx,0:DRAW i*lx,gridy*ly:NEXT:RETURN
1580 ' Re-Draw Grid.
1590 obx=bx:oby=by:FOR bx=1 TO gridx:FOR by=1 TO gridy:brush=sprite(bx,by)
1600 IF brush<>0 THEN GOSUB 890
1610 NEXT by,bx:bx=obx:by=oby:GOSUB 1570:RETURN
1620 ' Load In Sprite Data
1630 MODE 1:PEN 1:INK 1,26:INK 0,0:PAPER 0:CLS:template$="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.-:":l=16:PRINT"Please Enter File Name To Load Data":PRINT:PRINT"> ";:GOSUB 1150:GOSUB 580
1640 MODE 1:PRINT"Thank you. LOADing : ";b$
1650 OPENIN b$
1660 INPUT #9,nmd
1670 IF md<>nmd THEN MODE 1:PRINT"This Sprite Is Not For The Current Mode";CHR$(7):PRINT:PRINT"Do You Wish To Convert It To Mode";md:GOSUB 1780:IF an=0 THEN md=nmd
1680 INPUT #9,ngridx,ngridy:IF ngridy>gridy OR ngridx>gridx THEN ERASE sprite:DIM sprite(ngridx,ngridy):gridx=ngridx:gridy=ngridy:GOTO 1700
1690 IF ngridx<gridx OR ngridy<gridy THEN MODE 2:PRINT"This Sprite Is Smaller Than Your Template":PRINT:PRINT"Do You Wish to Convert it":GOSUB 1780:IF an=0 THEN ERASE sprite:DIM sprite(ngridx,ngridy):gridx=ngridx:gridy=ngridy
1700 ' Get Ink Colours
1710 FOR i=0 TO 15:INPUT #9,col(i,1),col(i,2):NEXT
1720 ' Get Sprite
1730 FOR i=1 TO ngridx
1740 INPUT#9,wri$:FOR t=1 TO ngridy:sprite(i,t)=VAL("&"+MID$(wri$,t,1)):NEXT t
1750 NEXT i
1760 CLOSEIN
1770 MODE md:bx=1:by=1:set=1:GOTO 290
1780 ' Input Yes/No Exit With an=0 = No and an=1 for Yes
1790 a$=UPPER$(INKEY$):IF a$<>"Y" AND a$<>"N" THEN 1790
1800 IF a$="Y" THEN an=1 ELSE an=0
1810 RETURN
1820 'Toggle Sprite Border
1830 MOVE boxx,boxy:DRAW boxx+(gridx*mo+mo),boxy,opp1:DRAW boxx+(gridx*mo+mo),gridy*2+2:DRAW boxx,gridy*2+2:DRAW boxx,boxy:RETURN
1840 ' Select Section Of Matrix To Copy Display On The Screen And Reset Flag.
1841 LOCATE 1,3:PRINT SPACE$(15);
1850 cx1=bx:cy1=by
1860 IF cx>cx1 THEN cx2=cx:cx=cx1:cx1=cx2
1870 IF cy>cy1 THEN cy2=cy:cy=cy1:cy1=cy2
1871 FOR i=0 TO 108 STEP 2:MOVE boxx,gridy*2+(6+i):DRAWR 50*mo+2*mo,0,0:NEXT
1880 MOVE boxx,gridy*2+6
1890 DRAWR (cx1-cx)*mo+2*mo,0,1:DRAWR 0,(cy1-cy)*2+4
1900 DRAWR -(2*mo+(cx1-cx)*mo),0:DRAWR 0,-((cy1-cy)*2+4)
1910 pastel=cx1-cx+1
1920 pastew=cy1-cy+1
1930 FOR i=1 TO pastew:FOR t=1 TO pastel
1940 paste(t,i)=sprite(t+cx-1,i+cy-1)
1950 PLOT boxx+t*mo,(gridy*2)+6+i*2,paste(t,i)
1960 NEXT t,i
1970 cutf=0:pastef=1:RETURN
1980 'Box Section Top Right
1990 DRAWR lx*(bx-cx+1),0,opp2
2000 DRAWR 0,ly*(by-cy+1)
2010 DRAWR -lx*(bx-cx+1),0
2020 DRAWR 0,-ly*(by-cy+1)
2030 RETURN
2040 'Box Section Top Right
2050 DRAWR lx*(bx-cx+1),0,opp2
2060 DRAWR 0,-ly*(cy-by)
2070 DRAWR -lx*(bx-cx+1),0
2080 DRAWR 0,ly*(cy-by)
2090 RETURN
2100 'Box Bottom Right
2110 DRAWR lx*(bx-cx),0,opp2
2120 DRAWR 0,ly*(by-cy+1)
2130 DRAWR -lx*(bx-cx),0
2140 DRAWR 0,-ly*(by-cy+1)
2150 RETURN
2160 DRAWR lx*(bx-cx),0,opp2
2170 DRAWR 0,-ly*(cy-by)
2180 DRAWR -lx*(bx-cx),0
2190 DRAWR 0,ly*(cy-by)
2200 RETURN
5000 'Paste The Sprite At Current Cursor Position.
5010 IF pastel=0 THEN RETURN
5020 px=bx:py=by
5030 WHILE px<>pastew AND px<gridx
5040 sprite(px+t-1,py+i-1)=paste(t,i):GOSUB 980
5050 px=px+1
5060 WEND