Post by Admin on Apr 1, 2018 22:15:33 GMT
Be sure to save the program in a directory that can be written to, as it needs to create a BMP image for the sprite demo.
INSTALL @lib$+"SPRITELIB"
cy%=0:di%=0
REM width;height;charwidth,charheight,number of colors,character set
VDU 23,22,1024;600;8,15,16,1 :REM max width is 1920 and 1440 height
IF FN_initsprites(10) = 0 STOP
PROCsbox(0,0,100,100,"black","white")
REM texture x,y,r,g,b
cy%=5
di%=3:REM the feared dimmer "EEEEEEKKK!!!"
REPEAT
cy%=cy%+2
PROCtexture(30,cy%,255,200,250,di%)
UNTIL cy%>90
REM ***create a mask for the selected area and save new sprite as mybox.bmp **
PROCmask(0,0,101,100,"mybox")
PROCpixel(500,500,"green")
REM mask must be before _getbmp.. otherwise it wont update
PROC_getbmp(9,"mybox")
REM sprite #, x,y, 0=off 1= on
FOR X=100 TO 1000 STEP 5
PROC_movesprite(9,X,100,1)
WAIT 1
NEXT X
PROC_exitsprites
REM Turn off the text cursor _
OFF
VDU 5 : REM Treat text as graphics (transparent background)
PROCset(200,200,"5")
c%=TINT(0,0)
PROCpr(110,100,"TEST: THE MASK IS CREATED","green")
WAIT 0
END
REM local color assignment is faster than using PROCcolor in this case
REM speed helps with intense texture work and the variables are easier to work with
DEFPROCtexture(x%,y%,br%,bg%,bb%,cd%)
LOCAL stage1%,stage2%,edger%,edgel%,cr%,cl%,di%
edger%=x%
edgel%=x%
REPEAT
IF cr%=0 THEN cr%=TINT(edger%,y%):edger%+=1
UNTIL cr%>0
edger%-=1
REPEAT
IF cl%=0 THEN cl%=TINT(edgel%,y%):edgel%-=1
UNTIL cl%>0
edgel%+=1
coun%=0:di%=0
temp%=0
REPEAT
COLOUR 0,br%-di%,bg%-di%,bb%-di%
GCOL 0
MOVE x%+coun%,y%:DRAW x%+coun%,y%
coun%=coun%+1
temp%=x%+coun%
di%+=cd%
UNTIL temp%=edger%
coun%=0:di%=0
temp%=0
REPEAT
COLOUR 0,br%-di%,bg%-di%,bb%-di%
GCOL 0
MOVE x%-coun%,y%:DRAW x%-coun%,y%
coun%=coun%+1
temp%=x%-coun%
di%+=cd%
UNTIL temp%=edgel%
ENDPROC
REPEAT
COLOUR 0,br%,bg%,bb% : GCOL 0
UNTIL x%=stage1%
REM h and v must always be a higher value as they are the top right corner of the image.( I make make this smart like sbox)
DEFPROCmask(x%,y%,h%,v%,name$)
LOCAL dx%,dy%,c%,counx%,couny%
counx%=0:couny%=0
dx%= h%-x%
dy%= v%-y%
IF dx%>dy% OR dx%=dy% THEN
REPEAT
c%=TINT(x%+counx%,y%+couny%)
IF c%=0 THEN PROCpixel(x%+counx%,y%+couny%+dy%+1,"light white") ELSE PROCpixel(x%+counx%,y%+couny%+dy%+1,"0")
couny%+=1:IF couny%=y%+dy% THEN couny%=0:counx%=counx%+1
UNTIL counx%=dx%
ENDIF
IF dy%>dx% THEN
REPEAT
c%=TINT(x%+counx%,y%+couny%)
IF c%=0 THEN PROCpixel(x%+counx%,y%+couny%+dy%+1,"255,255,255") ELSE PROCpixel(x%+counx%,y%+couny%+dy%+1,"0")
counx%+=1:IF counx%=x%+dx% THEN counx%=0:couny%=couny%+1
UNTIL couny%=dy%
ENDIF
OSCLI "SCREENSAVE """+name$+""" "+STR$(x%)+","+STR$(y%)+","+STR$(dx%)+","+STR$(dy%*2)
ENDPROC
DEFPROCpixel(x%,y%,c$)
PROCcolor("f",c$)
MOVE x%,y%:DRAW x%,y%
ENDPROC
REM this may slow things a bit, but I want to change it
DEFPROC_getbmp(num%,bmpname$)
LOCAL a%
bmpname$+=".bmp"
IF FN_createspritefrombmp(num%,bmpname$) = 0 THEN
ERROR 100, "Couldn't create "+bmpname$+" sprite"
ENDIF
ENDPROC
REM c$ can be colors like blue or 1 or a R,G,B color
DEF PROCset(x%,y%,c$)
LOCAL h%
PROCcolor("f",c$)
FOR h%=0 TO 20
LINE x%+h%,y%,x%+h%,y%+20
NEXT
MOVE 0,0
ENDPROC
REM c$ is fill color. b$ is border color
DEF PROCsbox(x%,y%,w%,h%,c$,b$)
LOCAL ry%,sx%,sy%
sx%=x%:sy%=y%
IF x%>w% THEN x%=w%:w%=sx%
IF y%>h% THEN y%=h%:h%=sy%
ry%=y%
PROCcolor("f",c$)
REPEAT
LINE x%,y%,w%,y%
y%=y%+1
UNTIL y%=h%
y%=ry%
PROCcolor("f",b$)
LINE x%+2,y%+2,w%-2,y%+2
LINE w%-2,y%+2,w%-2,h%-4
LINE w%-2,h%-4,x%+2,h%-4
LINE x%+2,h%-4,x%+2,y%+2
ENDPROC
REM color "F"or"B", "color name number or R G B"
REM this was created to manage special colors and to hold onto the original first 2 pallets (as I use them all the time)
DEF PROCcolor(fb$,rgb$)
IF rgb$="0" OR rgb$="black" THEN rgb$="000,000,000"
IF rgb$="1" OR rgb$="red" THEN rgb$="200,000,000"
IF rgb$="2" OR rgb$="green" THEN rgb$="000,200,000"
IF rgb$="3" OR rgb$="yellow" THEN rgb$="200,200,000"
IF rgb$="4" OR rgb$="blue" THEN rgb$="000,000,200"
IF rgb$="5" OR rgb$="magneta" THEN rgb$="200,000,200"
IF rgb$="6" OR rgb$="cyan" THEN rgb$="000,200,200"
IF rgb$="7" OR rgb$="white" THEN rgb$="200,200,200"
IF rgb$="8" OR rgb$="grey" THEN rgb$="056,056,056"
IF rgb$="9" OR rgb$="light red" THEN rgb$="248,056,056"
IF rgb$="10" OR rgb$="light green" THEN rgb$="056,248,056"
IF rgb$="11" OR rgb$="light yellow" THEN rgb$="248,248,056"
IF rgb$="12" OR rgb$="light blue" THEN rgb$="056,056,248"
IF rgb$="13" OR rgb$="light magnetta" OR rgb$="light purple" THEN rgb$="248,056,248"
IF rgb$="14" OR rgb$="light cyan" THEN rgb$="056,248,248"
IF rgb$="15" OR rgb$="light white" THEN rgb$="248,248,248"
PRIVATE assemble$,br%,bg%,bb%
assemble$=rgb$
br%=VAL(MID$(assemble$,1,3)):bg%=VAL(MID$(assemble$,5,3)):bb%=VAL(MID$(assemble$,9,3))
IF fb$="f" OR fb$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0
IF fb$="b" OR fb$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1
ENDPROC
REM X,Y,text color,message,r,g,b
REM ************************************************************************
DEF PROCpr(X,Y,msg$,c$)
LOCAL initialx%,fi%,reduction%,tx,ty
initialx%=LEN(msg$)
PROCcolor("f",c$)
GCOL 0
LET tx= X+initialx%+25
LET ty= Y:reduction%=0
reduction%=initialx%/2
reduction%=reduction%*6
IF initialx%<20 THEN reduction%=reduction%/2
initialx%=initialx%*22-reduction%
FOR fi%=12 TO 48
LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%
NEXT
COLOUR 0,0,0,0
GCOL 0
MOVE tx,ty
PRINT msg$
MOVE 0,0 REM hide that thing
ENDPROC