10REM      SPRITE EDITOR
20REM      CONVERTS IMAGES TO  A 64 CHARACTER HEX STRING
30REM      AN AID IN PROGRAM CONVERSION USING ROUTINES APPEARING IN
40REM      THE ADAM TECNICAL JOURNAL PUBLISHED BY
50REM      SERENDIPITY PRODUCTIONS 
60REM      P.O. BOX 07592
70REM      MILWAUKEE, WI 53207
75REM   COVERTED BY ROBERT WILC0X
80DATA     245,197,1,0,0,62,0,211,191,62,0,211,191,227,227,227
90DATA    227,227,227,62,0,211,190,11,120,177,32,247,193,241,201 
100DATA    245,62,0,211,191,62,0,211,191,227,227 
110DATA    227,227,0,0,219,190,50,0,0,241,201,0,0,0,0   
120 ux=PEEK(16102)*256+PEEK(16101)-2
130 ux=PEEK(ux)+PEEK(ux+1)*256+10
140FOR ui=ux TO ux+56:READ ua:POKE ui, ua:NEXT ui
150 ut=ux+55:POKE ux+50, INT(ut/256):POKE ux+49, ut-INT(ut/256)*256
160POKE 17059, 0:TEXT:GOTO 780
170REM                 CALL POSITION SN=SPRITE #  RETURNS YP(ROW) & XP(COL) 
180POKE 17009, 0:POKE ux+33, sn*4+128:POKE ux+37, 63:CALL ux+31: yp=PEEK(ux+55)
190POKE 17009, 0:POKE ux+33, sn*4+129:CALL ux+31: xp=PEEK(ux+55)
200REM                 CALL DELSPRITE (SINGLE) SN=SPRITE #   
210 ua=8:GOSUB 430:RETURN
220REM                 CALL DELSPRITE (ALL)
230 ua=16256: ub=0: uc=127:GOSUB 340:RETURN
240REM                  DISPLAY AT row,col m$ = string r = row c = col 
250FOR i=1 TO LEN(m$)
260 ur=r: u1=c+i: ub=ASC(MID$(m$, i, 1)): uc=1:GOSUB 480
270NEXT
280RETURN
290REM               VERT DISPLAY AT row,col m$ =string r = row c =   col 
300FOR i=1 TO LEN(m$)
310 ur=r+i: u1=c: ub=ASC(MID$(m$, i, 1)): uc=1:GOSUB 480
320NEXT
330RETURN
340REM                  POKEVM routine ua=address ub=data uc=number of copies  
350 uw=INT(ua/256): uy=ua-uw*256: uw=uw+64:POKE ux+6, uy:POKE ux+10, uw:POKE ux+20, ub:POKE ux+4, INT(uc/256)
360POKE 17009, 0
370POKE ux+3, uc-INT(uc/256)*256:CALL ux:RETURN
380REM                 CALL MAGNIFY SZ=FACTOR 1 TO 4   
390 sz=sz-1: bg=-385:GOSUB 710
400 bg=-249:GOSUB 710
410 bg=-1340+sz:GOSUB 710
420RETURN
430REM                 CALL PATTERN SN=SPRITE # UA=PATTTERN #       
440POKE ux+10, 127:POKE ux+6, sn*4+130:POKE ux+20, ua:POKE ux+3, 1:POKE ux+4, 0:POKE 17009, 0:CALL ux:RETURN
450REM                 CALL LOCATE SN=SPRITE # YR(ROW) XC(COL)    
460POKE ux+10, 127:POKE ux+6, sn*4+128:POKE ux+20, yr:POKE ux+3, 1:POKE ux+4, 0:POKE 17009, 0:CALL ux
470POKE 17009, 0:POKE ux+20, xc:POKE ux+6, sn*4+129:CALL ux:RETURN
480REM                 CALL HCHAR UB=ASCII UC= REPS UR=ROW U1=COL CALL CLEAR (UR=1:U1=1:UB=32:UC=768:GOSUB 480) 
490 ua=((ur-1)*32+u1-1)+2048:GOSUB 340: ua=ua+4096:GOSUB 340:RETURN
500REM                 CALL CHAR US=ASCII US$=CHARACTER DEFINITION  
510FOR ui=1 TO 16 STEP 2:IF LEN(us$)<>16 THEN ? CHR$(7); "INCORRECT LENGTH IN PATTERN# "; us:RETURN
520 u1=ASC(MID$(us$, ui, 1))
530 u2=ASC(MID$(us$, ui+1, 1))
540IF u1<60 THEN  u1=u1-48:GOTO 560
550 u1=u1-55
560IF u2<60 THEN  u2=u2-48:GOTO 580
570 u2=u2-55
580 ub=u1*16+u2: ua=(ui+1)/2+us*8-1: uc=1:GOSUB 340:NEXT
590RETURN
600REM                 CALL SPCHAR US=PATTERN # US$=CHARACTER DEFINITION 
610 ll=LEN(us$):IF ll=16 THEN 630
620IF ll<>64 THEN ? CHR$(7); "INCORRECT PATTERN LENGTH #s":RETURN
630 us=us+1792:IF ll=16 THEN GOSUB 510:RETURN
640FOR ui=1 TO 64 STEP 2:GOSUB 520:RETURN
650REM                 CALL COLOR US=CHARACTER SET # UF =FORE GROUND COLOR UB=BACKGROUND COLOR
660 ua=us+8191: ub=uf*16+ub: uc=1:GOSUB 340:RETURN
670POKE 17009, 0
680 uw=INT(ua/256): uy=ua-uw*256:POKE ux+33, uy:POKE ux+37, uw:CALL ux+31: ub=PEEK(ux+55):RETURN
690REM               CALL SPRITE SN=SPRITE # UA=PATTERN SC=SPRITE COLOR YR=ROW XC=COL               
700GOSUB 430:GOSUB 740:GOSUB 460:RETURN
710REM                 CALL SCREEN  BG=COLOR CODE 
720 ua=18176+bg:POKE ux+16, 24:POKE ux+17, 10:GOSUB 340:POKE ux+16, 227:POKE ux+17, 227:RETURN
730REM                 CALL SPCOLOR SN=SPRITE # SC=SPRITE COLOR  
740POKE ux+10, 127:POKE ux+6, sn*4+131:POKE ux+20, sc:POKE ux+3, 1:POKE ux+4, 0:POKE 17009, 0:CALL ux:RETURN
750REM                 CALL GCHAR UR=ROW U1=COL UB=DATA    96 ua = ((ur-1)*32+u1-1)+6144: GOSUB 670: RETURN  
760 ua=((ur-1)*32+u1-1)+6144:GOSUB 670:RETURN
770DIM b(16, 16): sc=7
780REM               SPRITE EDITOR
790 us=16: uf=0: ub=0:GOSUB 650
800DIM b(16, 16): sc=7
810 bg=7:GOSUB 710: zz=bg
820 c1=6
830 us=100: us$="0000000000000000":GOSUB 500
840 us=101: us$="FFFFFFFFFFFFFFFF":GOSUB 500
850 us=102: us$="FFFFC3C3C3C3FFFF":GOSUB 600
860 us=13: uf=1: ub=15:GOSUB 650
870 ur=1: u1=1: ub=32: uc=768:GOSUB 480
880VTAB 1:HTAB 10:? "SPRITE EDITOR"
890FOR r=1 TO 16: ur=4+r: u1=2: ub=100: uc=16:GOSUB 480:NEXT
900 sz=1:GOSUB 390
910REM   
920GOSUB 220
930 sn=28: ua=102: sc=13: yr=32: xc=8:GOSUB 700
940 ur=21: u1=1: ub=32: uc=31:GOSUB 480: ur=22: u1=1: ub=32: uc=31:GOSUB 480
950VTAB 22:HTAB 2: m$="USE ARROW KEYS TO MOVE CURSOR":? m$
960VTAB 23:HTAB 2: m$="PRESS 1 - PIXEL ON ,0 - OFF":? m$
970 r=24: c=2: m$="PRESS P TO DISPLAY SPRITE":GOSUB 240
980 r=1: c=1: kc=100
990GET k$: k=ASC(k$)
1000IF k=48 THEN  kc=100
1010IF k=49 THEN  kc=101
1020IF k=163 THEN  c=c-1:GOTO 1070
1030IF k=161 THEN  c=c+1:GOTO 1070
1040IF k=160 THEN  r=r-1:GOTO 1070
1050IF k=162 THEN  r=r+1:GOTO 1070
1060IF k=80 OR k=112 THEN 1140
1070IF c<1 THEN  c=16
1080IF c>16 THEN  c=1
1090IF r<1 THEN  r=16
1100IF r>16 THEN  r=1
1110 sn=28: yr=(8*r)+25: xc=8*c+1:GOSUB 450
1120 ur=4+r: u1=1+c: ub=kc: uc=1:GOSUB 480
1130? CHR$(7); CHR$(7); CHR$(128); :GOTO 990
1135GOTO 990
1140GOSUB 220
1150 ur=21: u1=1: ub=32: uc=128:GOSUB 480
1160 r=22: c=2: m$="ADAM IS WRITING THE CODE":GOSUB 240
1170FOR r=1 TO 16
1180FOR c=1 TO 16
1190 ur=4+r: u1=1+c:GOSUB 750
1200 gc=ub-100
1210 b(r, c)=gc
1220NEXT c
1230NEXT r
1240 hx$="0123456789ABCDEF"
1250 m$=""
1260FOR r=1 TO 16
1270 lw=b(r, 5)*8+b(r, 6)*4+b(r, 7)*2+b(r, 8)+1
1280 hi=b(r, 1)*8+b(r, 2)*4+b(r, 3)*2+b(r, 4)+1
1290 m$=m$+MID$(hx$, hi, 1)+MID$(hx$, lw, 1)
1300NEXT r
1310FOR r=1 TO 16
1320 lw=b(r, 13)*8+b(r, 14)*4+b(r, 15)*2+b(r, 16)+1
1330 hi=b(r, 9)*8+b(r, 10)*4+b(r, 11)*2+b(r, 12)+1
1340 m$=m$+MID$(hx$, hi, 1)+MID$(hx$, lw, 1)
1350NEXT r
1360 us=104: us$=m$:GOSUB 600
1370 sz=3:GOSUB 380
1380 mm=3
1390 m=4
1400 sn=1: ua=104: c1=3: yr=50: xc=170:GOSUB 700
1410 ur=21: u1=1: ub=32: uc=31:GOSUB 480: ur=22: u1=1: ub=32: uc=31:GOSUB 480
1420VTAB 21:HTAB 2: m$="C COLOR  M MAGNIFY T EDIT":? m$
1430VTAB 22:HTAB 2: m$="A ERASE  Q QUIT  B BACKGRD":? m$
1440VTAB 23:HTAB 2: m$="USE ARROW KEYS TO MOVE CURSOR":? m$
1450 r=24: c=2: m$="L LISTS CODE":GOSUB 240
1460GET k$: k=ASC(k$)
1470IF k=76 OR k=108 THEN 1600
1480IF k=81 OR k=113 THEN 1590
1490IF k=65 OR k=97 THEN 870
1500IF k=66 OR k=98 THEN GOSUB 1760
1510IF k=84 OR k=116 THEN 900
1520IF k=77 OR k=109 THEN 1540
1525IF k=67 OR k=99 THEN 1730
1530GOTO 1460
1540 sz=m:GOSUB 380
1550IF m=3 THEN  m=4:GOTO 1570
1560 m=mm
1570FOR d=1 TO 20:NEXT
1580GOTO 1460
1590POKE 17059, 4:TEXT:END
1600GOSUB 220
1610PR #1:HOME:?:?:?:? "PATTERN = "; us$
1620REM 
1630? "SPRITE COLOR = "; sc
1640? "BACKGROUND COLOR = "; zz
1650? "MAGNIFICATION = "; sz
1660?:?:?:?:?
1670PR #0
1680VTAB 21:HTAB 3: m$="A - ERASE  Q - QUIT  ":? m$
1690GET k$: k=ASC(k$)
1700IF k=81 OR k=113 THEN 1750
1710IF k=65 OR k=97 THEN 860
1720GOTO 1690
1730 c1=c1+1:IF c1>15 THEN 1750
1740 sn=1: sc=c1:GOSUB 730:GOTO 1460
1750 c1=1: sn=1: sc=c1:GOSUB 730:GOTO 1460
1760REM             CALL SCREEN  
1770 bg=zz+1: zz=bg:IF bg=16 THEN  bg=1: zz=1
1780GOSUB 710:RETURN
1790STOP
65535REM    DO uE>
S?S?cccccc>S>x1 wAqIu>pS?>