RETROLIB 10 + REFERENCE MOD March 2018
Post by michael on Dec 12th, 2016, 04:23am
RETROLIB 10 and the new reference text file and a tree link:
https://1drv.ms/f/s!AmYwmTjbmULXlAOzlJftEz2Pqgv-
Thanks to Zaphod and Richard for their help
This library is made to assist new programmers with ideas on how to manage graphics and other things. I declare it FREE AND OPEN SOURCE. Here is a definition:
https://en.wikipedia.org/wiki/Free_and_open-source_software
MARCH 2018: Added FNtype(x,y) - allows graphics user input at x,y (this tool is very stable on all platforms)
OCTOBER 22, 2017:
** ADDED commands
FNabutton(x,y,size%,c$,com$) - creates a mouse interactive box at x,y
setup each button like this:
res$=FNabutton(100,100,25,"green","fill") - creates the 25x25 box fills with green (to set up before use)
after setup -
IF FNabutton(100,100,25,"green","clicked")="clicked" THEN PRINT "you clicked on the box"
"clicked" is sent to FNabutton and if you click in the 25x25 area it checks, it returns "clicked" to the user.
PROCarrowu(x,y) and PROCarrowd(x,y) -creates simple arrows for up or down at x,y using active foreground color
**********************************************
NEW !! FNgkey tool added to RETROLIB
A tool to check common game keys and return a string description for assessment
snippet:
Code: REM game key checker
DEFFNgkey
LOCAL rk$
IF INKEY(-66) THEN rk$="A"
IF INKEY(-82) THEN rk$="S"
IF INKEY(-51) THEN rk$="D"
IF INKEY(-34) THEN rk$="W"
IF INKEY(-74) THEN rk$="ENTER"
IF INKEY(-99) THEN rk$="SPACE"
IF INKEY(-26) THEN rk$="LEFT"
IF INKEY(-122) THEN rk$="RIGHT"
IF INKEY(-58) THEN rk$="UP"
IF INKEY(-42) THEN rk$="DOWN"
=rk$
UPDATE: new edge shaded block tool (requires rest of library)
example:
PROCslate(x%,y%,size%,r%,g%,b%)
Code:PROCslate(100,100,200,200,200,255)
procedure
Code: REM NEW shaded edged block
DEFPROCslate(x%,y%,size%,r%,g%,b%)
LOCAL cun%,r$,g$,b$,cd%
FOR cun%=120 TO 0 STEP-11
PROCcrgb(r%-cun%,g%-cun%,b%-cun%)
PROCrect(x%+cd%,y%+cd%,x%+size%-cd%,y%+size%-cd%)
cd%+=1
NEXT cun%
r$=FNnumstr(r%):g$=FNnumstr(g%):b$=FNnumstr(b%)
PROCpaint(x%+cd%+1,y%+cd%+1,r$+","+g$+","+b$)
ENDPROC
SAMPLE code of the new color controls "string based for string uses"
PROCbcolor("color name or number") -set a background color
PROCfcolor("color name or number") -set a foreground color
Code:
PROCgraphics(1000,600)
REM set background color to core color 2 (green)
PROCbcolor("green")
CLG
PROCfcolor("yellow")
CIRCLE FILL 500,500,100
PROCset(300,300,"light white")
MOVE 0,0
END
REM SET c$ can be colors like blue or 1 ... NOTE SET is modified for this example.. IN RETROLIB 6, it can accept RRR,GGG,BBB values
REM GRAPHICS(x,y)
DEF PROCgraphics(x,y)
VDU 23,22,x;y;8,15,16,1
OFF
VDU 5
ENDPROC
DEF PROCset(x%,y%,c$)
LOCAL h%
PROCfcolor(c$)
FOR h%=0 TO 20
LINE x%+h%,y%,x%+h%,y%+20
NEXT
MOVE 0,0
ENDPROC
REM restore default color palettes
DEFPROCresetrgb
COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
COLOUR 15,248,248,248
ENDPROC
DEFFNstcorecol(wdnum$)
PROCresetrgb
LOCAL tcol%
CASE wdnum$ OF
WHEN "0","black" :tcol%=0
WHEN "1","red" :tcol%=1
WHEN "2","green" :tcol%=2
WHEN "3","yellow" :tcol%=3
WHEN "4","blue" :tcol%=4
WHEN "5","magneta" :tcol%=5
WHEN "6","cyan":tcol%=6
WHEN "7","white":tcol%=7
WHEN "8","grey":tcol%=8
WHEN "9","light red":tcol%=9
WHEN "10","light green":tcol%=10
WHEN "11","light yellow":tcol%=11
WHEN "12","light blue":tcol%=12
WHEN "13","light magneta":tcol%=13
WHEN "14","light cyan":tcol%=14
WHEN "15","light white" :tcol%=15
ENDCASE
=tcol%
DEF PROCfcolor(co$)
LOCAL rcol%
rcol%=FNstcorecol(co$)
GCOL rcol%
ENDPROC
DEF PROCbcolor(co$)
LOCAL rcol%
rcol%=FNstcorecol(co$)
GCOL 128 +rcol%
ENDPROC
Re: RETROLIB 3 link -try it out
Post by Zaphod on Dec 21st, 2016, 8:55pm
So I took a look at this and there are a few problems.
PROCgo especially. The diagonals ne, se, nw and sw directions don't give the right lengths because of the pixel by pixel method of plotting, which is a bad idea anyway. They are lengthened by root 2.
Secondly the line color of the lines is ignored and each pixel is plotted a different color! It gives a dark line.
If you are interested in a cleaned up version of that procedure here it is.
Code: DEFPROCgo(cm$,coun%)
REM Simplified. Line draws the right color and right length now. Much faster. Zaphod
PRIVATE x%,y%,pen%,c$
REM x% ,y% are already in @vdu.p.x%, @vdu.p.y% so are not needed to be kept separately as PRIVATE variables
REM @vdu.g.x has all the color details. BB4W Help "System Variables"
LOCAL c%,xinc%,yinc%,dist%
CASE cm$ OF
WHEN "up" : pen%=1
WHEN "down" : pen%=0
WHEN "fill" : PROCpaint(x%,y%,STR$(coun%))
WHEN "c" : c$=STR$(coun%):PROCcolor("f",c$)
ENDCASE
dist%=INT(coun%/SQR(2)+0.5) REM round to the nearest pixel for 45° angles
CASE cm$ OF
WHEN "n" : yinc%=coun% : xinc%=0
WHEN "s" : yinc%=-coun% : xinc%=0
WHEN "e" : yinc%=0 : xinc%=coun%
WHEN "w" : yinc%=0 : xinc%=-coun%
WHEN "ne" :yinc%=dist% : xinc%=dist%
WHEN "nw" :yinc%=dist% : xinc%=-dist%
WHEN "sw" :yinc%=-dist% : xinc%=-dist%
WHEN "se" :yinc%=-dist% : xinc%=dist%
ENDCASE
IF pen% =0 IF (ABS(yinc%)+ABS(xinc%))<>0 THEN LINE x%,y%,x%+xinc%,y%+yinc%
x%+=xinc%:y%+=yinc%
ENDPROC
The rgb conversion routines like FNrgb are somewhat messy and are much simpler done taking note on how the data is stored and shifting the bits out as you need them. You can also make use of byte variables to force the results to the 0-255 range. If you look at your b% it can be outside that range, but BB4W seems to tolerate that. Here is a suggestion:
Code: REM *****SPECIAL RGB tools (color extraction) has use with PROCdotrgb
DEF PROCrgbret(x%,y%,RETURN r%,RETURN g%,RETURN b%)
LOCAL rgb%
rgb%=TINT(x%,y%)
r%=rgb% AND &FF
g%=rgb%>>8 AND &FF
b%=rgb%>>16 AND &FF
ENDPROC
REM experimental
DEFFNrgb(x%,y%)
LOCAL rgb%, r&, g&, b&
rgb%=TINT(x%,y%)
r&=rgb% :REM Use byte variable as mask.
g&=rgb% >>8
b&=rgb% >>16
=FNnumstr(r&)+","+FNnumstr(g&)+","+FNnumstr(b&)
And finally just so I could work out what was going on I tidied up PROCgr using CASE rather than multiple IF's
Code: DEFPROCgr(cmd$)
PRIVATE pen$,x%,y%,angle
LOCAL x$,y$,h$,v$,c$,word$,size$,size2$,lx%,ly%,build$,wd$,r$,g$,b$,rr%,gg%,bb%,di%,di$,amt$,name$,h%,v%,resp$,speed$,speed,amt%,coun%
REPEAT
word$ = FNword(cmd$)
CASE word$ OF
WHEN "color" : c$=FNword(cmd$) : PROCcolor("f",c$)
WHEN "r" : angle=angle - VAL(FNword(cmd$))
WHEN "l" : angle=angle + VAL(FNword(cmd$))
WHEN "f" : PROCturtle(VAL(FNword(cmd$)),angle,pen$,x%,y%)
WHEN "rect" : x$=FNword(cmd$):y$=FNword(cmd$):h$=FNword(cmd$):v$=FNword(cmd$) :PROCrect(VAL(x$),VAL(y$),VAL(h$),VAL(v$))
WHEN"graphics" : PROCgraphics(1000,600)
WHEN"mask" : x$=FNword(cmd$):x%=VAL(x$):y$=FNword(cmd$):y%=VAL(y$):h$=FNword(cmd$):h%=VAL(h$):v$=FNword(cmd$):v%=VAL(v$)
PROCmask(x%,y%,h%,v%)
WHEN"size" : size$=FNword(cmd$):PROCdotsize(VAL(size$))
WHEN"move" :
x$=FNword(cmd$):y$=FNword(cmd$)
lx%= VAL(x$)
ly%= VAL(y$)
x%=lx%:y%=ly%
PROCturtle(0,angle,"move",x%,y%)
PROCgo("move",0)
WHEN"ellipse" :
x$=FNword(cmd$):y$=FNword(cmd$):size$=FNword(cmd$):size2$=FNword(cmd$):di$=FNword(cmd$)
PROCellipse(VAL(x$),VAL(y$),VAL(size$),VAL(size2$),r%,g%,b%,VAL(di$))
WHEN"print" : PROCpr(lx%,ly%,FNbuild(cmd$),"15")
WHEN"say" : PROCspeak(FNbuild(cmd$),Pitch%,Speed%,Voice$)
WHEN"rgb" :
r$=FNword(cmd$):g$=FNword(cmd$):b$=FNword(cmd$)
r%=VAL(r$):g%=VAL(g$):b%=VAL(b$)
PROCcrgb(r%,g%,b%)
WHEN"block" :
x$=FNword(cmd$):y$=FNword(cmd$):size$=FNword(cmd$):di$=FNword(cmd$)
PROC_block(VAL(x$),VAL(y$),VAL(size$),r%,g%,b%,VAL(di$))
REM button x y di
WHEN"button" :
x$=FNword(cmd$):y$=FNword(cmd$):di$=FNword(cmd$)
x%=VAL(x$):y%=VAL(y$):di%=VAL(di$)
PROC_button(x%,y%,15,25,r%,g%,b%,di%)
WHEN"sbox" :
x$=FNword(cmd$):y$=FNword(cmd$):h$=FNword(cmd$):v$=FNword(cmd$):
c$=FNword(cmd$)
PROCsbox(VAL(x$),VAL(y$),VAL(h$),VAL(v$),c$)
WHEN"sphere" :
x$=FNword(cmd$):y$=FNword(cmd$):size$=FNword(cmd$):di$=FNword(cmd$)
PROC_sphere(VAL(x$),VAL(y$),VAL(size$),r%,g%,b%,VAL(di$))
WHEN"savebmp" :
name$=FNword(cmd$)+".bmp":x$=FNword(cmd$):x%=VAL(x$):y$=FNword(cmd$):y%=VAL(y$):h$=FNword(cmd$):h%=VAL(h$):v$=FNword(cmd$):v%=VAL(v$)
OSCLI "SCREENSAVE """+name$+""" "+STR$(x%)+","+STR$(y%)+","+STR$(h%)+","+STR$(v%)
WHEN"loadbmp" :
name$=FNword(cmd$)+".bmp":x$=FNword(cmd$):x%=VAL(x$):y$=FNword(cmd$):y%=VAL(y$):h$=FNword(cmd$):h%=VAL(h$):v$=FNword(cmd$):v%=VAL(v$)
OSCLI "DISPLAY """+name$+""" "+STR$(x%)+","+STR$(y%)+","+STR$(h%)+","+STR$(v%)
WHEN"lefteye" :
x$=FNword(cmd$):y$=FNword(cmd$):location$=FNword(cmd$):speed$=FNword(cmd$):speed=VAL(speed$)
FOR x=1 TO 40:PROClefteye(VAL(x$),VAL(y$),location$,speed):PROCrighteye(VAL(x$)-100,VAL(y$),location$,speed):NEXT x
WHEN "c","n","s","e","w","ne","nw","se","sw","fill" :
resp$=word$
amt$=FNword(cmd$)
amt%=VAL(amt$)
PROCgo(resp$,amt%)
WHEN "up","down" : pen$=word$:PROCgo(word$,0)
WHEN"cls" : CLG
ENDCASE
UNTIL word$ = ""
ENDPROC
DEF FNbuild(a$) :REM Used by PROCgr
LOCAL b$,build$
REPEAT
b$= FNword(a$)
IF b$<>":" THEN build$+=" "+b$
UNTIL b$="" OR INSTR(":.?",RIGHT$(b$))>0
=build$
There are still some unused variables there but my aim was simply to get to understand what you were doing. I think this still has the original function but could still be streamlined some more.
And talking about streamlining, here is the PROCspeak.
Code: DEF PROCspeak(phrase$,pitch%,speed%,voice$)
tts% = FN_createobject("Sapi.SpVoice")
IF tts% THEN
LOCAL qual$
qual$ = "<PITCH ABSMIDDLE="""""+STR$pitch%+"""""/><RATE ABSSPEED="""""+STR$speed%+"""""/>"
IF voice$<>"" qual$ += "<VOICE REQUIRED=""""NAME="+voice$+"""""/>"
PROC_callmethod(tts%, "Speak("""+qual$+phrase$+""")")
PROC_releaseobject(tts%)
REM ENDPROC
ENDIF
REM Windows 95 and 16 bit only. Obsolete.
REM tts% = FN_createobject("Speech.VoiceText")
REM IF tts% THEN
REM PROC_callmethod(tts%, "Register("""",""COMLIB demo"")")
REM PROC_putvalue(tts%, "Enabled(BTRUE)")
REM PROC_putvalue(tts%, "Speed("+STR$INT(150*3^(speed%/10))+")")
REM PROC_callmethod(tts%, "Speak("""+phrase$+""", 1)")
REM REPEAT
REM SYS "Sleep", 150
REM UNTIL FN_getvalueint(tts%, "IsSpeaking") = 0
REM PROC_releaseobject(tts%)
REM ENDPROC
REM ENDIF
ENDPROC
Over half of the code, now REMed is obsolete, unless you run 16 bit versions of Windows, prior to Windows 2000.
Z
Re: RETROLIB 3 link -try it out
Post by michael on Dec 21st, 2016, 10:20pm
Thanks for your contribution.
I will work on those alterations you supplied.
There is lots of work to be done to make this perfect so that people will finally have a tool to make creating things quickly and simply.
Re: RETROLIB 4 -exercise and demo button
Post by Zaphod on Dec 22nd, 2016, 1:24pm
I noticed that you have two procedures that are identical for the left and right eye movements.
All you really need is separate variables for the two eyes.
In BB4W you can do this:
Code: DEFPROCrighteye(x,y,location$,speed): PRIVATE dx,dy,counx,couny,eyeh,eyev,seyeh,seyev
DEFPROClefteye(x,y,location$,speed) : PRIVATE dx,dy,counx,couny,eyeh,eyev,seyeh,seyev
...
...
ENDPROC
A line starting with DEF is ignored as a program line by BB4W so if you put the PRIVATE declarations on that line it will not be seen by the other procedure. Thus you get two sets of independent variables.
Z
Re: RETROLIB 4 -exercise and demo button
Post by michael on Dec 22nd, 2016, 2:08pm
Yes, the eyes were made to work separately.
In case, say the perspective was a toon facing right and only one eye was visible. But they need to be resizable, as a person making different types of toons, may want small eyes. (or one eye for each direction)
The eyes are a work in progress
Re: RETROLIB 4 -exercise and demo button
Post by Zaphod on Dec 22nd, 2016, 3:11pm
Although the code is common the two eyes are entirely separate because the variables will be a different set for each. The code works exactly as it did before but in half as many lines.
The two eyes can be entirely different in size speed and action.
Z
Re: RETROLIB 4 -exercise and demo button
Post by Zaphod on Dec 22nd, 2016, 4:52pm
If you are going to use PROCbuttonz like this
Code: REPEAT
m$=FNbuttonz(10,500,"Exercise")
m$=FNbuttonz(500,500,"Graphics Demo")
UNTIL m$<>""
you really need to include a WAIT 0 in that Procedure code or you lock up one core of your CPU running flat out.
Z
Re: RETROLIB 5- many more demos and improvements
Post by michael on Dec 22nd, 2016, 5:36pm
OOOPS !! Sorry about that !! Its fixed..
Re: RETROLIB 6- here is your Christmas tree
Post by Zaphod on Dec 22nd, 2016, 9:14pm
I can't keep up!
So I was looking at the code for PROCbuttonz. It seemed to me that you were just poking around putting in numbers trying to get it to look right, so I went back to basics. The x and y now refer to the button buttom - left as with all BB4W graphics. The Width is self selecting and works down to 1 character of text. The height is one and a half text cells.
Code: DEFFNbuttonz(x%,y%,msg$)
LOCAL mx%,my%,mb%,dx%,dy%,c$
PRIVATE st$ :REM Stops later buttons wiping out a hit.
REM How much space at ends?
REM Let's start with 1/4 of the text length as space each end, so total will be 3/2 times text pixels.
REM Graphics units are pixels * 2
dx%=LEN(msg$)*3/2*@vdu%!216*2
REM Now for the height. Let's make the box 1.5 times the text height
dy%=@vdu%!220*3 :REM Remember this is graphics units so 1.5 * 2.
MOUSE mx%,my%,mb%
IF mx% >x% AND mx%<(x%+dx%) AND my%<(y%+dy%) AND my%>y% THEN
c$="255,255,255"
IF mb%=4 THEN st$=msg$
ELSE
c$="200,200,200"
ENDIF
IF FNrgb(x%+1,y%+1)<>c$ THEN
PROCcolor("f",c$)
RECTANGLE FILL x%, y%, dx%, dy%
PROCcolor("f","000,000,000")
REM Position of text in window.
REM Text character cell is dimensioned from top, Graphics box from the bottom.
MOVE x%+dx%/6, y%+dy%*3/4 :REM If font sizes change increase to theoretical 5/6.
PRINT msg$
ENDIF
WAIT 0
=st$
If you change the text size in the VDU23,22 statement it should all still size proportionately and in other modes.
Z
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 22nd, 2016, 10:26pm
Quote:
Its ok... I will make modifications as you make changes.. I just update the name of the same post to reflect the changes and change the message and make the new link to the edited code..
I am actually extremely slow today.. Its hard to stay focused.
I need to get all this stuff done before newyears so I can get started on D3D content for RETROLIB.. (adjustable premade 3D creations .. imagine)
I appreciate your efforts.
I still have tonnes of content to add.. There is the new perspective type 3D sphere and other images I have already made that need to be added.
AND there is the holy grail of 2D to 3D image tools:
The depth shader filler (its not really a filler, rather its a converter that creates a custom new shaded image from a 2D image that is filled)... (it is a tough project but I got it to work)
I will be taking a break though, for a few hours.
Re: RETROLIB 6- here is your Christmas tree
Post by Zaphod on Dec 23rd, 2016, 7:22pm
Looking again at FNbuttonz functionality it is quite restrictive in how it can be used. The problem is that the returned message is kept in a PRIVATE variable so it effectively latches the button result. This means that you can only use it in a situation, like with the demo, where once one button is hit you exit the loop.
In normal programs where you have a background loop running and buttons trigger actions this really is no good. One way to solve this is to get rid of the PRIVATE variable and then each line would be something like
Code:m$=FNbuttonz(x%,y%,"string"): IF m$<>"" THEN do action
Which actually makes more sense than getting the message and doing a separate set of interrogations to find out what value of m$ was returned as the original demo does.
A slightly more sophisticated method is to include the action procedure into the button sensing by a direct call to the action procedure by supplying it as a parameter. This is probably best shown as an example, so here is a little working program.
Code: REM Demo of button with automatic direction to action procedure.
PROCgraphics(500,300)
Done%=FALSE
REPEAT
PROCbuttonz(100,300,"One", PROCone)
PROCbuttonz(500,300,"Two", PROCtwo)
UNTIL Done%
VDU 4
CLS
END
DEF PROCtwo :S$="2"
VDU 7
WAIT 50
DEF PROCone :S$="1"
VDU7
ENDPROC
DEFFNrgb(x%,y%) :REM by Zaphod
LOCAL rgb%, r&, g&, b&
rgb%=TINT(x%,y%)
r&=rgb% :REM Use byte variable as mask.
g&=rgb% >>8
b&=rgb% >>16
=FNnumstr(r&)+","+FNnumstr(g&)+","+FNnumstr(b&)
DEFFNnumstr(num)
LOCAL cov$, l%, ret%
cov$=STR$(num)
l%=LEN(cov$)
IF l%=1 THEN ret$="00"+cov$
IF l%=2 THEN ret$="0"+cov$
IF l%=3 THEN ret$=cov$
=ret$
DEF PROCgraphics(x,y)
VDU 23,22,x;y; 8,15,16,1
OFF
VDU 5
ENDPROC
DEF PROCbuttonz(x%,y%,msg$,RETURN I%) :REM by Zaphod
LOCAL mx%,my%,mb%,dx%,dy%,c$
dx%=LEN(msg$)*3*@vdu%!216 :REM Window 1.5 times text length, 1.5 times text height
dy%=@vdu%!220*3 :REM Remember this is pixels so 1.5 * 2 = 3 BB4W graphics units.
MOUSE mx%,my%,mb%
IF mx% >x% AND mx%<(x%+dx%) AND my%<(y%+dy%) AND my%>y% THEN
c$="255,255,255"
IF mb%=4 THEN PROC(^I%)
ELSE
c$="200,200,200"
ENDIF
IF FNrgb(x%,y%)<>c$ THEN
PROCcolor("f",c$)
RECTANGLE FILL x%, y%, dx%, dy%
PROCcolor("f","000,000,000")
MOVE x%+dx%/6, y%+dy%*5/6 :REM Adjust text offset from window origin.
PRINT msg$
ENDIF
WAIT 0
ENDPROC
DEF PROCcolor(fb$,rgb$)
CASE rgb$ OF
WHEN "0" , "black" ,"000,000,000": rgb=&0
WHEN "1" , "red" ,"200,000,000": rgb=&0000C8
WHEN "2" , "green" ,"000,200,000": rgb=&00C800
WHEN "3" , "yellow" ,"200,200,000": rgb=&00C8C8
WHEN "4" , "blue" ,"000,000,200": rgb=&C80000
WHEN "5" , "magenta","200,000,200": rgb=&C800C8
WHEN "6" , "cyan" ,"000,200,200": rgb=&C8C800
WHEN "7" , "white" ,"200,200,200": rgb=&C8C8C8
WHEN "8" , "grey" ,"056,056,056": rgb=&383838
WHEN "9" , "light red" ,"248,056,056" : rgb=&3838F8
WHEN "10" , "light green" ,"056,248,056" : rgb=&38F838
WHEN "11" , "light yellow","248,248,056" : rgb=&38F8F8
WHEN "12" , "light blue" ,"056,248,248" : rgb=&F83838
WHEN "13" , "light magenta","248,056,248": rgb=&F838F8
WHEN "14" , "light cyan" ,"056,056,248": rgb=&F83838
WHEN "15" , "light white" ,"255,255,255": rgb=&F8F8F8
OTHERWISE rgb =0
ENDCASE
IF fb$="f" OR fb$="F" THEN COLOUR 0, rgb, rgb>>8, rgb>>16 : GCOL 0
IF fb$="b" OR fb$="B" THEN COLOUR 1, rgb, rgb>>8, rgb>>16 : GCOL 128+1
ENDPROC
Here we put PROCbuttonz(100,300,"One", PROCone) and when the button is pressed the PROCone procedure is activated. The loop continues untill Done% is set to TRUE which is a global flag that you would set in one of the procedures, probably an Exit button.
All this program does is bleep once or twice so you need sound on!
Z
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 23rd, 2016, 10:26pm
In a loop where multiple cycles of button checks would take place, I would just clear the return string at the end of the conditions in the main program or in the procedure using it to ensure nothing repeated.
I will be touching this up and will start focusing completely on my game. The library will stay available to users of BBC4W.
My game will use the objects in the library, but the game itself will become commercial.
If you want to help improve the library, I would be grateful.
Re: RETROLIB 6- here is your Christmas tree
Post by Zaphod on Dec 23rd, 2016, 11:41pm
Quote:| In a loop where multiple cycles of button checks would take place, I would just clear the return string at the end of the conditions in the main program or in the procedure using it to ensure nothing repeated. |
|
I would be interested to see how you would do that. You can't clear the variable that is PRIVATE so it would pop up again and again.
Are you (or anyone else) interested in how to pass parameters to the indirect button calls that I described earlier or is that a little too advanced?
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 24th, 2016, 12:19am
Ill take a look at it.. I thought I had the safety measures built in.. I tested it before.. Perhaps, I may have used an older version.. Ill see
The PRIVATE string is absolutely necessary to carry the active button pressed forward through all the button checks.
I didn't see the issue till you brought it up.. But I really thought I fixed that..
It is fixed !! Test it out. The "clearitall" command must be called at the start of the button list of checks .. Should be perfect.
I did the modifications in a matter of a couple minutes..
I think I know what happened.. some of this was mixed up with the custom button project.. I made a similar tool with special protections but I guess I didn't pass it on to this amazing ultra simple tool.
Re: RETROLIB 6- here is your Christmas tree
Post by Zaphod on Dec 24th, 2016, 02:47am
Ho! Ho! Ho!
You have added : m$=FNbuttonz(0,0,"clearitall")
If it was clicked it would exit the loop prematurely and if it isn't then the old value stays in m$ from any previous results.
Merry Christmas.
Z
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 24th, 2016, 02:57am
LOL.. ill make the next modification.. I'm just multitasking
It doesn't seem to have a problem.. I will test it.
HMMM.. now m$="" when the loop returns to top..
Now try it
OH and I just barely saved it again in case I forgot to save it
Try it now.. It should be flawless.
Re: RETROLIB 6- here is your Christmas tree
Post by Zaphod on Dec 24th, 2016, 03:47am
No, it only works for a one button press and exits as you are doing. Clearing m$ does nothing new. m$ gets given the data from the PRIVATE variable as soon as any button is pressed and stays that way.
Try to generate a loop where you can repeatedly select one of two buttons as in my example. It may take a while.....
Anyway I think I have contributed all I can on this project. There is so much code that needs cleaning up before you go any further. And please delete that extra ENDIF that screws up the indent formatting. Where? Use the Cross reference utility, that will tell you about that and so much more.
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 24th, 2016, 03:58am
Yeah.. I fixed the ENDIF issue..
I also went through the unused variables and cleaned them up except for 2 because they were needed..
As for the lowercase keyword issues.. I know about that..
It is designed for Uppercase keywords..
I like the keywords the way they are.
I will look to see if there is any possible issues with the button use.. It has worked well for me on my other project. But perhaps I haven't provided a real test worthy of buttonz..
Ill try a few tests.
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 24th, 2016, 06:14am
Here is a Buttonz example. This is the original test.
It functions well and is in a constant loop. So a person can switch back and forth between responses.. And this is the old version (RETROLIB 2). (with lots of code removed to make it fit )
Code:
PROCgraphics(1000,600)
ON ERROR END
REPEAT
a$= FNbuttonz(300,300,"Limitless buttons and no need for complexity !!")
a$= FNbuttonz(100,100,"This is a button TEST")
IF a$<>"" THEN PROCpr(200,200,"you clicked on "+a$+"","255,255,255")
WAIT 10
UNTIL FALSE
END
REM RETROLIB 2
DEF PROC_button(H,V,BEGIN,SIZE,X,C,A,DI)
PROCcolor("f","000,000,000")
LOCAL R,G,B,P
R=X
G=C
B=A
P=SIZE-BEGIN
P=P/2
P=BEGIN+P
FOR Y=P TO SIZE
COLOUR 1,X,C,A :GCOL 1
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X-DI
C=C-DI
A=A-DI
IF X<2 THEN X=2
IF C<2 THEN C=2
IF A<2 THEN A=2
NEXT Y
P=SIZE-BEGIN
P=P/2
P=BEGIN+P
FOR Y=BEGIN TO P
COLOUR 1,X,C,A :GCOL 1
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X+DI
C=C+DI
A=A+DI
NEXT Y
COLOUR 1,R,G,B:GCOL 1
FILL H,V
PROCresetrgb
ENDPROC
DEF PROC_block(H,V,SIZE,X,C,A,DI)
LOCAL P,Y
P=SIZE/2
FOR Y=1 TO SIZE
COLOUR 0,X,C,A:GCOL 0
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X-DI
C=C-DI
IF X<2 THEN X=2
IF C<2 THEN C=2
IF A<2 THEN A=2
P=P-1
NEXT Y
ENDPROC
DEFPROCdotsize(n)
VDU 23,23,n|
ENDPROC
REM COLORMIX object mixer
DEFFNcolormix(x,y)
PRIVATE rgb$,r%,g%,b%,switch%
LOCAL h%,v%,click%
MOUSE h%,v%,click%
IF click%=4 THEN
IF h%>x AND h%<x+50 AND v%>y AND v%<y+255 THEN r%=v%-y
IF h%>x+49 AND h%<x+90 AND v%>y AND v%<y+255 THEN g%=v%-y
IF h%>x+99 AND h%<x+140 AND v%>y AND v%<y+255 THEN b%=v%-y
ENDIF
IF switch%=0 OR click%=4 THEN
PROCsbox(x-5,y-5,x+150,y+265,"255,255,255")
PROCsbox(x,y+r%,x+40,y+r%+10,"200,000,000")
PROCsbox(x+50,y+g%,x+90,y+g%+10,"000,200,000")
PROCsbox(x+100,y+b%,x+140,y+b%+10,"000,000,200")
switch%=1
rgb$=FNnumstr(r%)+","+FNnumstr(g%)+","+FNnumstr(b%)
PROCsbox(x-5,y+265,x+150,y+295,rgb$)
ENDIF
=rgb$
REM GRAPHICS(x,y)
DEF PROCgraphics(x,y)
VDU 23,22,x;y;8,15,16,1
OFF
VDU 5
REM these variables are temporary
N%=0
N%=20
DIM X(20),Y(20),H(20),V(20)
ENDPROC
DEFFNkey
response$=INKEY$(0)
=response$
REM SBOX **********************
DEF PROCsbox(x%,y%,w%,h%,c$)
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%
IF c$<>"0" THEN PROCcolor("f","000,000,000") ELSE PROCcolor("f","white")
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
PROCresetrgb
ENDPROC
REM RECT **********************
DEFPROCrect(x%,y%,w%,h%)
LOCAL sx%,sy%
sx%=x%:sy%=y%
IF x%>w% THEN x%=w%:w%=sx%
IF y%>h% THEN y%=h%:h%=sy%
LINE x%,y%,w%,y%
LINE w%,y%,w%,h%
LINE w%,h%,x%,h%
LINE x%,h%,x%,y%
ENDPROC
REM pixel *******************
DEFPROCpixel(x%,y%,c$)
IF c$<>"" THEN PROCcolor("f",c$)
MOVE x%,y%:DRAW x%,y%
ENDPROC
REM SET 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 restore default color palettes
DEFPROCresetrgb
COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
COLOUR 15,248,248,248
ENDPROC
DEF PROCcolor(fb$,rgb$)
PRIVATE assemble$,br%,bg%,bb%
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$="magenta" 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 magenta" 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"
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
DEFFNnumstr(num)
LOCAL cov$,l%
cov$=STR$(num)
l%=LEN(cov$)
IF l%=1 THEN ret$="00"+cov$
IF l%=2 THEN ret$="0"+cov$
IF l%=3 THEN ret$=cov$
=ret$
DEFPROCpaint(x%,y%,co$)
PROCcolor("b",FNrgb(x%,y%)):PROCcolor("f",co$)
FILL x%,y%
ENDPROC
REM dotrgb ********************************
DEFPROCdotrgb(x%,y%,r%,g%,b%)
COLOUR 0,r%,g%,b% : GCOL 0
MOVE x%,y%:DRAW x%,y%
ENDPROC
REM *****SPECIAL RGB tools (color extraction) has use with PROCdotrgb
DEF PROCrgbret(x%,y%,RETURN r%,RETURN g%,RETURN b%)
LOCAL rgb%
rgb%=TINT(x%,y%)
b%=INT(rgb%/(256*256))
g%=INT((rgb%-b% *256*256)/256)
r%=INT(rgb%-b%*256*256-g%*256)
ENDPROC
REM experimental
DEFFNrgb(x%,y%)
LOCAL r$,g$,b$,join$,r,g,b
rgb%=TINT(x%,y%)
b=INT(rgb%/(256*256))
g=INT((rgb%-b *256*256)/256)
r=INT(rgb%-b*256*256-g*256)
r$=FNnumstr(r):g$=FNnumstr(g):b$=FNnumstr(b)
join$=r$+","+g$+","+b$
=join$
REM "INTERFACE" -library - for graphics text input and other tools
REM X,Y,message,r,g,b
DEF PROCpr(X,Y,msg$,c$)
PRIVATE trackx,tracky,trackmsg$,trackc$
LOCAL initialx%,fi%,reduction%,tx,ty
IF trackx=X AND tracky=Y AND trackmsg$<>msg$ THEN PROCprsub(trackx,tracky,trackmsg$,"000,000,000")
IF trackx<>X OR tracky<>Y OR trackmsg$<>msg$ OR trackc$<>c$ THEN
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
ENDIF
trackx=X:tracky=Y:trackmsg$=msg$:trackc$=c$
ENDPROC
DEFPROCprsub(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
ENDIF
ENDPROC
DEFFNbuttonz(X,Y,msg$)
LOCAL initialx%,fi%,reduction%,tx,ty,mx%,my%,mb%,ad%,ady%,c$
PRIVATE st$
initialx%=LEN(msg$)
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%
MOUSE mx%,my%,mb%
ad%=initialx%+8:ad%+=X:ady%=Y-28
IF mx% >X AND mx%<ad% AND my%<Y+8 AND my%>ady% THEN
c$="255,255,255"
IF mb%=4 THEN st$=msg$
ELSE c$="200,200,200"
ENDIF
IF FNrgb(X,Y)="000,000,000" THEN c$="200,200,200"
PROCcolor("f",c$)
IF FNrgb(X,Y)<>c$ THEN
FOR fi%=12 TO 48
LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%
NEXT
PROCcolor("f","000,000,000")
MOVE tx,ty
PRINT msg$
ENDIF
MOVE 0,0 REM hide that thing
=st$
Re: RETROLIB 6- here is your Christmas tree
Post by Zaphod on Dec 25th, 2016, 12:15pm
Try this as an example program instead. It has the same basic code just does something slightly different from printing in the same spot each time.
Code: PROCgraphics(1000,600)
ON ERROR END
REPEAT
a$= FNbuttonz(300,300,"Limitless buttons and no need for complexity !!")
a$= FNbuttonz(100,100,"This is a button TEST")
IF a$="This is a button TEST" THEN GCOL RND(15)-1: RECTANGLE FILL RND(800),RND(600),RND(800),RND(600)
IF a$="Limitless buttons and no need for complexity !!" THEN GCOL RND(15)-1: CIRCLE FILL RND(800), RND(600), RND(200)
WAIT 10
UNTIL FALSE
END
Once you get it started it is difficult to stop. I don't think that is the intended behaviour of FNbuttonz.
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 25th, 2016, 2:06pm
It is the first test of FNbuttonz..
It doesn't have the changes I made. But there is one thing PROCpr has as a protection..
It checks to see if the same message and location is repeated and if it is then nothing changes..
If a different message overlays the location, then the old message is erased and replaced with the new.
Ill do this same test you provided with the new version of FNbuttonz..
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 25th, 2016, 3:16pm
Ok it actually is simpler than I made it before.. Now it should be flawless as long as this kind of structure is maintained.
I admit I was multitasking too much.. I will try to stress test my works more when they are being questioned for stability..
RETROLIB 6 has this test inserted in a program segment
and it is in the first link for RETROLIB 6
Code: PROCgraphics(1000,600)
ON ERROR END
REPEAT
a$= FNbuttonz(300,300,"clearitall")
a$= FNbuttonz(300,300,"Limitless buttons and no need for complexity !!")
a$= FNbuttonz(100,100,"This is a button TEST")
IF a$="This is a button TEST" THEN GCOL RND(15)-1: RECTANGLE FILL RND(800),RND(600),RND(800),RND(600)
IF a$="Limitless buttons and no need for complexity !!" THEN GCOL RND(15)-1: CIRCLE FILL RND(800), RND(600), RND(200)
WAIT 10
UNTIL FALSE
END
REM RETROLIB 2
DEF PROC_button(H,V,BEGIN,SIZE,X,C,A,DI)
PROCcolor("f","000,000,000")
LOCAL R,G,B,P
R=X
G=C
B=A
P=SIZE-BEGIN
P=P/2
P=BEGIN+P
FOR Y=P TO SIZE
COLOUR 1,X,C,A :GCOL 1
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X-DI
C=C-DI
A=A-DI
IF X<2 THEN X=2
IF C<2 THEN C=2
IF A<2 THEN A=2
NEXT Y
P=SIZE-BEGIN
P=P/2
P=BEGIN+P
FOR Y=BEGIN TO P
COLOUR 1,X,C,A :GCOL 1
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X+DI
C=C+DI
A=A+DI
NEXT Y
COLOUR 1,R,G,B:GCOL 1
FILL H,V
PROCresetrgb
ENDPROC
DEF PROC_block(H,V,SIZE,X,C,A,DI)
LOCAL P,Y
P=SIZE/2
FOR Y=1 TO SIZE
COLOUR 0,X,C,A:GCOL 0
LINE H-Y,V-Y,H+Y,V-Y
LINE H+Y,V-Y,H+Y,V+Y
LINE H+Y,V+Y,H-Y,V+Y
LINE H-Y,V+Y,H-Y,V-Y
X=X-DI
C=C-DI
IF X<2 THEN X=2
IF C<2 THEN C=2
IF A<2 THEN A=2
P=P-1
NEXT Y
ENDPROC
DEFPROCdotsize(n)
VDU 23,23,n|
ENDPROC
REM COLORMIX object mixer
DEFFNcolormix(x,y)
PRIVATE rgb$,r%,g%,b%,switch%
LOCAL h%,v%,click%
MOUSE h%,v%,click%
IF click%=4 THEN
IF h%>x AND h%<x+50 AND v%>y AND v%<y+255 THEN r%=v%-y
IF h%>x+49 AND h%<x+90 AND v%>y AND v%<y+255 THEN g%=v%-y
IF h%>x+99 AND h%<x+140 AND v%>y AND v%<y+255 THEN b%=v%-y
ENDIF
IF switch%=0 OR click%=4 THEN
PROCsbox(x-5,y-5,x+150,y+265,"255,255,255")
PROCsbox(x,y+r%,x+40,y+r%+10,"200,000,000")
PROCsbox(x+50,y+g%,x+90,y+g%+10,"000,200,000")
PROCsbox(x+100,y+b%,x+140,y+b%+10,"000,000,200")
switch%=1
rgb$=FNnumstr(r%)+","+FNnumstr(g%)+","+FNnumstr(b%)
PROCsbox(x-5,y+265,x+150,y+295,rgb$)
ENDIF
=rgb$
REM GRAPHICS(x,y)
DEF PROCgraphics(x,y)
VDU 23,22,x;y;8,15,16,1
OFF
VDU 5
REM these variables are temporary
N%=0
N%=20
DIM X(20),Y(20),H(20),V(20)
ENDPROC
DEFFNkey
response$=INKEY$(0)
=response$
REM SBOX **********************
DEF PROCsbox(x%,y%,w%,h%,c$)
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%
IF c$<>"0" THEN PROCcolor("f","000,000,000") ELSE PROCcolor("f","white")
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
PROCresetrgb
ENDPROC
REM RECT **********************
DEFPROCrect(x%,y%,w%,h%)
LOCAL sx%,sy%
sx%=x%:sy%=y%
IF x%>w% THEN x%=w%:w%=sx%
IF y%>h% THEN y%=h%:h%=sy%
LINE x%,y%,w%,y%
LINE w%,y%,w%,h%
LINE w%,h%,x%,h%
LINE x%,h%,x%,y%
ENDPROC
REM pixel *******************
DEFPROCpixel(x%,y%,c$)
IF c$<>"" THEN PROCcolor("f",c$)
MOVE x%,y%:DRAW x%,y%
ENDPROC
REM SET 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 restore default color palettes
DEFPROCresetrgb
COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
COLOUR 15,248,248,248
ENDPROC
DEF PROCcolor(fb$,rgb$)
PRIVATE assemble$,br%,bg%,bb%
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$="magenta" 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 magenta" 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"
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
DEFFNnumstr(num)
LOCAL cov$,l%
cov$=STR$(num)
l%=LEN(cov$)
IF l%=1 THEN ret$="00"+cov$
IF l%=2 THEN ret$="0"+cov$
IF l%=3 THEN ret$=cov$
=ret$
DEFPROCpaint(x%,y%,co$)
PROCcolor("b",FNrgb(x%,y%)):PROCcolor("f",co$)
FILL x%,y%
ENDPROC
REM dotrgb ********************************
DEFPROCdotrgb(x%,y%,r%,g%,b%)
COLOUR 0,r%,g%,b% : GCOL 0
MOVE x%,y%:DRAW x%,y%
ENDPROC
REM *****SPECIAL RGB tools (color extraction) has use with PROCdotrgb
DEF PROCrgbret(x%,y%,RETURN r%,RETURN g%,RETURN b%)
LOCAL rgb%
rgb%=TINT(x%,y%)
b%=INT(rgb%/(256*256))
g%=INT((rgb%-b% *256*256)/256)
r%=INT(rgb%-b%*256*256-g%*256)
ENDPROC
REM experimental
DEFFNrgb(x%,y%)
LOCAL r$,g$,b$,join$,r,g,b
rgb%=TINT(x%,y%)
b=INT(rgb%/(256*256))
g=INT((rgb%-b *256*256)/256)
r=INT(rgb%-b*256*256-g*256)
r$=FNnumstr(r):g$=FNnumstr(g):b$=FNnumstr(b)
join$=r$+","+g$+","+b$
=join$
REM "INTERFACE" -library - for graphics text input and other tools
REM X,Y,message,r,g,b
DEF PROCpr(X,Y,msg$,c$)
PRIVATE trackx,tracky,trackmsg$,trackc$
LOCAL initialx%,fi%,reduction%,tx,ty
IF trackx=X AND tracky=Y AND trackmsg$<>msg$ THEN PROCprsub(trackx,tracky,trackmsg$,"000,000,000")
IF trackx<>X OR tracky<>Y OR trackmsg$<>msg$ OR trackc$<>c$ THEN
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
ENDIF
trackx=X:tracky=Y:trackmsg$=msg$:trackc$=c$
ENDPROC
DEFPROCprsub(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
ENDPROC
DEFFNbuttonz(X,Y,msg$)
LOCAL initialx%,fi%,reduction%,tx,ty,mx%,my%,mb%,ad%,ady%,c$
PRIVATE st$
IF msg$<> "clearitall" THEN
initialx%=LEN(msg$)
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%
MOUSE mx%,my%,mb%
ad%=initialx%+8:ad%+=X:ady%=Y-28
IF mx% >X AND mx%<ad% AND my%<Y+8 AND my%>ady% THEN
c$="255,255,255"
IF mb%=4 THEN st$=msg$
ELSE c$="200,200,200"
ENDIF
IF FNrgb(X,Y)="000,000,000" THEN c$="200,200,200"
PROCcolor("f",c$)
IF FNrgb(X,Y)<>c$ THEN
FOR fi%=12 TO 48
LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%
NEXT
PROCcolor("f","000,000,000")
MOVE tx,ty
PRINT msg$
ENDIF
ENDIF
IF msg$="clearitall" THEN st$=""
MOVE 0,0 REM hide that thing
=st$
Re: RETROLIB 6- here is your Christmas tree
Post by Zaphod on Dec 25th, 2016, 5:07pm
At last it almost works as you would expect.
Great. It is not by the method I would have chosen :I would have got rid of the private variable and process the loop differently like I mentioned in an earlier post.
Now all it needs is detection of the button being released so that holding down the button does not give repeated hits so it is like a windows button (or any GUI in the last 30 years), or you put in a delay before you get repeats like on a keyboard key so that old slow coaches, such as me, don't get 3 circles per click instead of just one.
By the way your last post has that pesky surplus ENDIF again. If you fix it in the original code then you won't keep copying the error.
Do you intend to provide any documentation on how any of this code should be used?
Z
Re: RETROLIB 6- here is your Christmas tree
Post by michael on Dec 25th, 2016, 5:15pm
RETROLIB 6 has the bug fixes, including the ENDIF issue..
There is documentation for RETROLIB 2 and 3..
Although it needs to be updated, as RETROLIB 6 is looking like it has the necessary components and modifications to make it workable in projects
The example you see is a paste from RETROLIB 2 (with modifications and deletions and ... well its no longer RETROLIB 2... its a snippet
I will look to ensure that a person cant click 2 times on the same button and get a repeated response from that button...
But there is one problem..
If I do that then, what if the button is meant to adjust something ?
Perhaps I could just make a setting in the FNbuttonz syntax... so that it can serve more than one purpose.
A note: The WAIT command does give a person enough time to click on the button and avoid repeating the action... I could increase the WAIT command to lesson repeating something
There will be more content added to RETROLIB 6 in the future, but for now, it will stay the way it is until I get my game done.
I will work on improving its function as time passes.
It is a tool for the BBC Basic community.
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by Zaphod on Dec 25th, 2016, 10:50pm
Quote:I will look to ensure that a person cant click 2 times on the same button and get a repeated response from that button...
|
|
That is not what I think is needed. In the cases I suggested you can press repeatedly and get repeated actions. What you don't want is repeated actions from one brief press of the button.
The windows action requires that the button down and button up both occur on the same button for it to be actioned. I think that would be very difficult to achieve without a complete rewrite of the button procedures.
Achieving a keyboard type delay should be easy. Or you could tell the user that they should add a wait after the action procedure to stop additional triggering. That is where the documentation comes in. If you can tell the user the limitations of the code then all is well. It is just that you tend to hype your code as flawless which kind of builds up the user expectations.
Z
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by michael on Dec 25th, 2016, 11:47pm
After thinking about the possibilities, with a button check beyond, say a delay, it would add too many factors when keeping track of buttons pressed.
Buttonz is supposed to be simple and unlimited. (well what you can fit on a screen at any given time.. )
I believe it is the most simple button that can be made. The simple design of the buttonz FN is that it relies on what it is immediately given at the moment that it is being used or observed.
That, and for me, it was revolutionary in design, and simplicity.. It remade my programming strategy on other utilities that are not here yet, that rely on interface controls.
I will just make documentation for buttonz so a person knows how to make it work best.
I am not saying that buttonz couldn't be modified to do the checks, it just seems that monitoring it would be unnecessary.
My point being, that, if a button is pressed once.. it would do a pause then a task, then return to the beginning of the cycle, clear the function string and look for the next instruction.
By that time, the button should no longer be pressed.
Also, it is a simple alternative.. RETROLIB is a work in progress.
Its not perfection, but it works ..
An idea has crossed my mind about a FN that could keep a string list for any other FN or Procedure that would extract and insert the information, only allowing 1 instance of that string and giving it a time limit.. I am trying to work it out.
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by Zaphod on Dec 26th, 2016, 2:59pm
Quote:| After thinking about the possibilities, with a button check beyond, say a delay, it would add too many factors when keeping track of buttons pressed. |
|
Yes it would require you to keep a track of the buttons either by storing details in an array or something and I understand that you want to keep it simplistic. Certainly you can increase the WAIT time so that it effectively reduces the unwanted repeats, and that works well in most instances. But isn't the point of libraries so that you can hide sophisticated code which users don't need to know about the details of but just that it works. Take the COMLIB library that you use. That is pretty complex and I doubt that the code in there means much to most people but it is (relatively) simple to use. I am biased though as I wrote part of that code.
I still can't fathom why you want to go to the 'clearitall' solution rather than simply make st$ LOCAL in FNbuttonz and then you simply write the loop like this:
Code: REPEAT
a$=""
a$+= FNbuttonz(100,1100,"Limitless buttons and no need for complexity !!")
a$+= FNbuttonz(100,1000,"This is a RETROLIB 6 button TEST for DECEMBER 25 2016")
a$+= FNbuttonz(100,900,"Lets skip this and look at the next options")
IF a$="This is a RETROLIB 6 button TEST for DECEMBER 25 2016" THEN GCOL RND(15)-1: RECTANGLE FILL RND(800),RND(600),RND(800),RND(600)
IF a$="Limitless buttons and no need for complexity !!" THEN GCOL RND(15)-1: CIRCLE FILL RND(800), RND(600), RND(200)
WAIT 20
UNTIL a$="Lets skip this and look at the next options"
a$ then always reflects the button message that is currently pressed, and so it does not need to be unlatched by 'clearitall'.
That seems to me to be simpler still.
Or you could use the more direct action linking as I was suggesting on the 23rd. When I talked about getting rid of the PRIVATE variable st$ then. That is:
Code: REPEAT
a$= FNbuttonz(100,1100,"Limitless buttons and no need for complexity !!") : \
\ IF a$="Limitless buttons and no need for complexity !!" THEN GCOL RND(15)-1: CIRCLE FILL RND(800), RND(600), RND(200)
a$= FNbuttonz(100,1000,"This is a RETROLIB 6 button TEST for DECEMBER 25 2016") : \
\IF a$="This is a RETROLIB 6 button TEST for DECEMBER 25 2016" THEN GCOL RND(15)-1: RECTANGLE FILL RND(800),RND(600),RND(800),RND(600)
a$= FNbuttonz(100,900,"Lets skip this and look at the next options")
WAIT 20
UNTIL a$="Lets skip this and look at the next options"
Both of these options work.
And a final suggestion or request actually (really!) can you add Code:
SYS "MessageBox",@hwnd%,REPORT$,0,48
Z
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by Zaphod on Dec 26th, 2016, 4:49pm
Here is a variation on Michael's theme. UPDATED.
The code can be compacted if we don't do string comparisons but do boolean ones to see if the button is pressed. In this case the result will be TRUE or FALSE.
Then using BB4W's ability to do compound assignments you can simplify things quite a lot.
Let me stress that the ideas for this theme are Michael's and I have just re-coded various bits to make this minimal demo.
Code: REM Demo of buttons
REM Based on ideas by "Michael", recoded and revised by Zaphod. Dec 2016
ON ERROR SYS "MessageBox",@hwnd%, REPORT$,0,48
PROCgraphics(1000,600)
REPEAT
REM Note that the WAIT to avoid repeats is AFTER the action.
IF FNbuttonpressed(100,1100,"Rectangles") THEN GCOL RND(15)-1: RECTANGLE FILL RND(800),RND(600),RND(800),RND(600):WAIT 20
IF FNbuttonpressed(100,1000,"Circles") THEN GCOL RND(15)-1: CIRCLE FILL RND(800), RND(600), RND(200):WAIT 20
WAIT 0
UNTIL FNbuttonpressed(100,900,"Exit")
VDU 4
CLS
PRINT "That's all folks"
END
DEFFNrgb(x%,y%) :REM by Zaphod
LOCAL rgb%, r&, g&, b&
rgb%=TINT(x%,y%)
r&=rgb% :REM Use byte variable as mask.
g&=rgb% >>8
b&=rgb% >>16
=FNnumstr(r&)+","+FNnumstr(g&)+","+FNnumstr(b&)
DEFFNnumstr(num&)
LOCAL cov$
cov$=STR$(num&)
WHILE LEN(cov$)<3 cov$="0"+cov$ ENDWHILE
=cov$
DEF PROCgraphics(x%,y%)
VDU 23,22,x%;y%; 8,15,16,1
OFF
VDU 5
ENDPROC
DEF FNbuttonpressed(x%,y%,msg$) :REM by Zaphod
LOCAL mx%,my%,mb%,dx%,dy%,c$
REM Button is 1.5 time text height and 1.5 times text length.
dx%=LEN(msg$)*3*@vdu%!216
dy%=@vdu%!220*3
WAIT 0
MOUSE mx%,my%,mb%
IF mx% >x% AND mx%<(x%+dx%) AND my%<(y%+dy%) AND my%>y% THEN
c$="255,255,255"
IF mb%=4 THEN :=TRUE
ELSE
c$="200,200,200"
ENDIF
IF FNrgb(x%+2,y%+2)<>c$ THEN
PROCcolor("f",c$)
RECTANGLE FILL x%, y%, dx%, dy%
PROCcolor("f","000,000,000")
MOVE x%+dx%/6, y%+dy%*5/6 :REM Center text.
PRINT msg$
ENDIF
=FALSE
DEF PROCcolor(fb$,rgb$)
LOCAL assemble$,br%,bg%,bb%
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$="magenta" 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 magenta" 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"
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
Z
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by michael on Dec 26th, 2016, 5:28pm
Amazing work... There is one difference ..
FNbuttonz was designed to be simple and non flicker..
Richard did make issue with the fact that I needed to make my functions efficient.
You are more skilled than I am atm. (probably always will be) I am working on my skills.
I am sure you were planning to make the buttons not constantly redraw themselves.
I thought to point that out.. FNbuttonz is extremely efficient.
But then you did slap that great work together quick..
I will make minor improvements to RETROLIB over time, although, I don't plan to drastically change its structure, as it was made to assist people who are new to BBC Basic and those who would like to use it.
The Game I am working on might not even use any of the library,(but I will use the mask tool for sprite creation) as I may specialize each part, including the custom images. I do plan to advance far beyond this.
RETROLIB is just a plateau.. People can use it if they want.
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by Zaphod on Dec 26th, 2016, 6:59pm
Quote:| FNbuttonz was designed to be simple and non flicker.. |
|
I didn't change any of that code so the flicker may be down to the change from WAIT 10 to WAIT 0 in the main loop. I did not notice any flicker on my machine but that means nothing as each configuration is different. Maybe a WAIT of 1 or 2 might work better.
That was perhaps far too fast a refresh but the main loop wait time in this configuration is time that blocks the button down sensing so has to be less than a typical click duration or you might get occasional missed clicks, which is annoying. So yes this code does have that limitation. Locking refresh to the scan rate can be done but it is pretty darn complex and outside of the initial remit, I think.
Code:I am sure you were planning to make the buttons not constantly redraw themselves.
No, because I thought that might be difficult to do simply but I have just had a thought about that, so I might update it if it works out...
Stay tuned.
Z
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by michael on Dec 26th, 2016, 8:42pm
NOTICE: This tool is FREE and OPEN SOURCE. Here is an information link:
https://en.wikipedia.org/wiki/Free_and_open-source_software
Zaphod, you may want to use my strategy.
The breakthough with buttonz was if you used a palette color to identify what was at a specific location, you could also eliminated a need for tracking something with variables.
Add to that, you could be very strategic with complicated creations with just one palette location within a image deciding its status.
Of course on a project I mentioned to Richard about using palettes as a means of storing data was related to this subject.
And one day, while thinking of PEEK and POKE and memory and graphics plotting, that's when the idea came to me.
You could hide your design on a graphics page.. And it would only need a tool to look at it.
The other thing about FNbuttonz is that it doesn't require *REFRESH, because it only changes what you see if the palette environment requires it.
So technically, if say, your graphics screen was 1000x1000
then your data area would be 500x500 x3
And if I am wrong about the vertical reads, it would be:
500x1000x3
Mainly because the palette takes up space ( its just what I noticed.. I am not sure if a perfect pixel can store a palette on its own... especially with what I have read about LCD technology.
This seems to lend a type of Object Orientated Programming to this library. (in my opinion)
Code: DEFFNbuttonz(X,Y,msg$)
LOCAL initialx%,fi%,reduction%,tx,ty,mx%,my%,mb%,ad%,ady%,c$
PRIVATE st$
IF msg$<> "clearitall" THEN
initialx%=LEN(msg$)
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%
MOUSE mx%,my%,mb%
ad%=initialx%+8:ad%+=X:ady%=Y-28
IF mx% >X AND mx%<ad% AND my%<Y+8 AND my%>ady% THEN
c$="255,255,255"
IF mb%=4 THEN st$=msg$
ELSE c$="200,200,200"
ENDIF
IF FNrgb(X,Y)="000,000,000" THEN c$="200,200,200"
PROCcolor("f",c$)
IF FNrgb(X,Y)<>c$ THEN
FOR fi%=12 TO 48
LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%
NEXT
PROCcolor("f","000,000,000")
MOVE tx,ty
PRINT msg$
ENDIF
ENDIF
IF msg$="clearitall" THEN st$=""
MOVE 0,0 REM hide that thing
=st$
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by Zaphod on Dec 27th, 2016, 01:24am
Quote:Zaphod, you may want to use my strategy.
|
|
I thought I had but got tripped up by two things. First in changing to a rectangle draw I found I had to sense 2 pixels in to ensure I got the right colour picked up.
Secondly my variation of PROCcolor did not recognize properly how it worked so the original has been reinstated, except I made the PRIVATE variable LOCAL.
With that I believe that the redrawing occurs only when the button color changes, as it should.
I have updated the original post with these corrections and apologize for not realizing that it was not functioning correctly before. Thank you, Michael for pointing that out.
Z
Re: RETROLIB 6- here is your Christmas tree DEC 2
Post by michael on Dec 27th, 2016, 03:46am
Quote:| Secondly my variation of PROCcolor did not recognize properly how it worked so the original has been reinstated, except I made the PRIVATE variable LOCAL |
|
I looked carefully at your version of a buttonz like control..
It was interesting how you simplified it..
PROCcolor was a evolution of my color management right from the start.
It was a real show stopper, because it allowed certain control of colors for foreground and background color controls.
It, along with a few other tools I worked hard to refine.
I had to tediously check each palette RGB value and create them in the color interpreter to give the exact color for the original core colors.
The core colors would be EXACTLY the same palette, and I also discovered that the colors from 1- 15 were a special palette group.
The color 0 was truly predictable when used to match the whole range of colors.
It was a journey of discovery. I had to research how palettes worked for RGB and it took a long time.
But now I can easily control colors and get the value from any point on the screen.
The area that PROCcolor fails is with POINT..
The TINT color setting is correct, but POINT wont
see the redefined value of 0.
But in this case you don't need POINT and I really prefer TINT, as I love working with palettes.
When all else fails, PROCcolor is dependable and I know it will provide the results for core colors or words or RGB values.
I also created resetrgb to keep the core colors uncontaminated after a procedure.
And PROCcrgb(r%,g%,b%) which is the foreground fast color tool for the fastest palette control.
Also, quite a while ago, when I was told I should, I did try to use the Hexadecimal tactics you were using for PROCcolor.. It didn't work the way I expected it should work.. So that's why it is the way it is.
Right now I am studying D3D and the theory behind 3D creation, as it seems to be the most logical step forward.
If possible, I will add the object creation and controls into another version of RETROLIB.. Although it will most likely be a much more elaborate version with only the most powerful parts of the existing library.
Ric, you out there?
Re: RETROLIB 6- DEMOS DEC 27 -set
Post by Zaphod on Dec 27th, 2016, 5:03pm
Quote:| The area that PROCcolor fails is with POINT.. |
|
Yes, there are warnings in the manual about that if you start adjusting the palette. POINT works on the logical colors not the physical ones.
However code of the FNbuttonz type can work well with POINT if you don't mess with the palette. I know you like changing the palette so this is probably not for you , Michael.
Code: REM Demo of buttons
REM Based on ideas by "Michael", recoded and revised by Zaphod. Dec 2016
REM REV 2 minimalist version. Uses existing color pallette
ON ERROR SYS "MessageBox",@hwnd%, REPORT$,0,48
MODE 22
OFF: VDU 5
REPEAT
REM Note that wait to avoid repeats is AFTER the action.
IF FNbuttonpressed(100,1100,"Rectangles") THEN GCOL RND(15)-1: RECTANGLE FILL RND(800)+200,RND(600)+100,RND(800),RND(600):WAIT 20
IF FNbuttonpressed(100,1000," Circles ") THEN GCOL RND(15)-1: CIRCLE FILL RND(800)+200, RND(600)+100, RND(200):WAIT 20
WAIT 0
UNTIL FNbuttonpressed(100,900,"Exit")
REM Clean up.
CLG
VDU 4
COLOUR 15
PRINT "That's all folks"
END
DEF FNbuttonpressed(x%,y%,text$) :REM by Zaphod
REM Returns TRUE while mouse held down over button.
REM Button is 1.5 times text height and 1.5 thime text length.
REM It is auto sizing so same text length gives same button size if required.
LOCAL mx%,my%,mb%,dx%,dy%,c%
dx%=LEN(text$)*3*@vdu%!216
dy%=@vdu%!220*3
MOUSE mx%,my%,mb%
IF mx% >x% AND mx%<(x%+dx%) AND my%<(y%+dy%) AND my%>y% THEN
c%=14 :REM Highlight color
IF mb%=4 THEN :=TRUE
ELSE
c%=6 :REM Base button color
ENDIF
IF POINT(x%+2,y%+2)<>c% THEN
REM only repaint if the color needs to change.
GCOL c%
RECTANGLE FILL x%, y%, dx%, dy%
GCOL 15 :REM Text color
MOVE x%+dx%/6, y%+dy%*5/6 :REM Center text.
PRINT text$
ENDIF
=FALSE
As you can see this is minimalist BB4W code rather than Retrolib. In cases like this it is probably easier just to use straight BBC BASIC.
The issue with the color returned from TINT or rgb as hex is easy to understand once you realize that computers store their data differently from humans and have the least significant byte first.
The colors are thus Hex BBGGRR
Each hex digit is 4 bits so if we do a right shift of 8 bits BBGGRR >> 8
we get BBGG with the red now discarded. Similarly if we shift 16 bits we get the blue only.
If we take these results and put them into byte variables or AND with &FF and put them in to integer variables we have the three components separated.
Well thanks for keeping me entertained over the Christmas period.
Z
Re: RETROLIB 6- DEMOS DEC 27 -set
Post by michael on Dec 27th, 2016, 5:54pm
Quote: I know you like changing the palette so this is probably not for you , Michael.
|
|
Ahhh.. but it can still be done.. That's why I made PROCresetrgb
I could make a command that always gives a true core color
Perhaps
PROCcorec("f or b","number or word of color")
f or b would be the foreground and background controls
and numbers 0-15 or words like blue or light blue"
OR
I could just modify PROCcolor so that it actually serves you a core color for 0- 15 and for colors black - white
MEANWHILE still allowing RGB palette controls
After some insight on things, my position on programming would be:
It is not what I can or can't do, it is the limits that I place on myself. Its about telling myself what level my standards are at.
Code: REM Demo of buttons
REM Based on ideas by "Michael", recoded and revised by Zaphod. Dec 2016
REM REV 2 minimalist version. Uses existing color pallette
ON ERROR SYS "MessageBox",@hwnd%, REPORT$,0,48
MODE 22
OFF: VDU 5
REM lets ensure the palettes are correct
PROCresetrgb
REPEAT
REM Note that wait to avoid repeats is AFTER the action.
IF FNbuttonpressed(100,1100,"Rectangles") THEN GCOL RND(15)-1: RECTANGLE FILL RND(800)+200,RND(600)+100,RND(800),RND(600):WAIT 20
IF FNbuttonpressed(100,1000," Circles ") THEN GCOL RND(15)-1: CIRCLE FILL RND(800)+200, RND(600)+100, RND(200):WAIT 20
WAIT 0
UNTIL FNbuttonpressed(100,900,"Exit")
REM Clean up.
CLG
VDU 4
COLOUR 15
PRINT "That's all folks"
END
DEF FNbuttonpressed(x%,y%,text$) :REM by Zaphod
REM Returns TRUE while mouse held down over button.
REM Button is 1.5 times text height and 1.5 thime text length.
REM It is auto sizing so same text length gives same button size if required.
LOCAL mx%,my%,mb%,dx%,dy%,c%
dx%=LEN(text$)*3*@vdu%!216
dy%=@vdu%!220*3
MOUSE mx%,my%,mb%
IF mx% >x% AND mx%<(x%+dx%) AND my%<(y%+dy%) AND my%>y% THEN
c%=14 :REM Highlight color
IF mb%=4 THEN :=TRUE
ELSE
c%=6 :REM Base button color
ENDIF
IF POINT(x%+2,y%+2)<>c% THEN
REM only repaint if the color needs to change.
GCOL c%
RECTANGLE FILL x%, y%, dx%, dy%
GCOL 15 :REM Text color
MOVE x%+dx%/6, y%+dy%*5/6 :REM Center text.
PRINT text$
ENDIF
=FALSE
REM restore default color palettes
DEFPROCresetrgb
COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
COLOUR 15,248,248,248
ENDPROC
Re: RETROLIB 10 REFERENCE +FNgkey tool
Post by Zaphod on Jan 22nd, 2017, 10:02pm
Not sure if these are of any use, but here they are anyway!
[Updated Jan 24th to include a torus and ellipse, also made colors fade proportionally so only brightness changes not the color.]
These are developments from Michael's 'tools' ideas but are independent procedures that don't rely on lots of 'helper' procs, and don't leave the system in strange graphics configurations. That is to say none of Retrolib is used.
They also give shapes that are the size you think they should be and in the place you might expect them to be. Rectangular items have the origin at the bottom left and circular items at the center.
I also changed the color gradient so that 100% merges to black so 10% to 70% gives quite a useful range of shading gradients. They are small and thus could be put in a library.
Code:
MODE 8
PROCrectblockZ(100,600,500,300,200,100,200,80)
PROCsphereZ(1000,300,100,200,26,200,70)
PROCrectborderZ(800,500,320,200,21,200,100,170,60)
PROCgradcylZ(100,100,100,400,200,100,100,100)
PROCgradcylZ(300,100,400,100,250,50,50,90)
PROCellipseZ(400,400,100,150,150,50,200,100)
PROCtorroidZ(900, 900, 120, 100, 50, 40, 140, 240, 50)
REM RECTANGLE 900,200,200,200
REM RECTANGLE 300,250,200,300
REM REM RECTANGLE 800,800,200,200
ELLIPSE 400,400,100,150
END
DEF PROCellipseZ(x%,y%,dx%,dy%,r,g,b,d%):LOCAL type%, pen%: type%=1 :pen%=@vdu%!248: VDU 23,23,3|
DEF PROCrectblockZ(x%,y%,dx%,dy%,r,g,b,d%):LOCAL type%, pen%: type%=0
REM x,y are at bottom left.
REM dx% is width, d% is % progression to black.
LOCAL I%, d, k%, f, l, m, n, oldgcol&
oldgcol&=@vdu.g.b&
IF type% =0 x%+=dx%/2: y%+=dy%/2 :REM Find center. We work outwards.
IF dx%<dy% k%=dy%:f=dx%/dy% ELSE k%=dx% :f=dy%/dx% :REM adjust for aspect ratio.
d=d%/100/k%*4 :REM Get color proportion change per scan.
l=r*d : m=g*d : n=b*d
FOR I%=1 TO k%/2 STEP 2
COLOUR 0,r,g,b :GCOL 0
CASE type% OF
WHEN 0: IF dx%<dy% RECTANGLE x%-I%*f, y%-I%, 2*I%*f, 2*I% ELSE RECTANGLE x%-I%,y%-I%*f, 2*I%, 2*I%*f
WHEN 1: IF dx%<dy% ELLIPSE x%, y%, 2*I%*f, 2*I% ELSE ELLIPSE x%, y%, 2*I%, 2*I%*f
ENDCASE
r-=l:g-=m:b-=n :REM Adjust colors
NEXT
COLOUR 0,0,0,0 :GCOL oldgcol& :REM reset color 0 and plot mode.
IF pen% VDU 23,23,pen%|
ENDPROC
DEF PROCgradcylZ(x%,y%,dx%,dy%,r,g,b,d%)
REM x,y are at bottom left.
REM dx% is width, d% is % progression to black.
LOCAL I%, d, k%, f, oldgcol&, l, m, n
oldgcol&=@vdu.g.b&
x%+=dx%/2: y%+=dy%/2 :REM Find center. We work outwards.
IF dx%<dy% k%=dy%:f=dx%/dy% ELSE k%=dx% :f=dy%/dx% :REM adjust for aspect ratio.
d=d%/100/k%*2 :REM Get color proportion change per scan.
l=r*d : m=g*d : n=b*d
FOR I%=0 TO k%/2
COLOUR 0,r,g,b :GCOL 0
IF dx%<dy% RECTANGLE x%-I%*f, y%-k%/2, 2*I%*f, dy% ELSE RECTANGLE x%-k%/2,y%-I%*f, dx%, 2*I%*f
r-=l:g-=m:b-=n :REM Adjust colors
NEXT
COLOUR 0,0,0,0 :GCOL oldgcol& :REM reset color 0
ENDPROC
DEFPROCsphereZ(x%,y%,zrad%,r,g,b,d%) :REM Redundant: use ellipse.
PROCellipseZ(x%,y%,zrad%,zrad%,r,g,b,d%)
ENDPROC
DEF PROCtorroidZ(x%, y%, dx%, dy%, bwidth%, r, g, b, d%):LOCAL type%, pen%: type%=1 :pen%=@vdu%!248: VDU 23,23,2|
DEF PROCrectborderZ(x%, y%, dx%, dy%, bwidth%, r, g, b, d%) :LOCAL type%, pen%: type%=0 :REM d%=gradient per cent.
LOCAL I%, d, oldgcol&, l, m, n
oldgcol&=@vdu.g.b&
bwidth% AND= -2 :REM Make border width an even number.
d=d%/100/bwidth%*2 :REM Get color proportion change per scan.
l=r*d : m=g*d : n=b*d
FOR I% =1 TO bwidth%/2
COLOUR 0,r,g,b :GCOL 0
CASE type% OF
WHEN 0:
RECTANGLE x%+bwidth%/2-I%,y%+bwidth%/2-I%, dx%+2*I%-bwidth%, dy%+2*I%-bwidth%
RECTANGLE x%+bwidth%/2+I%,y%+bwidth%/2+I%, dx%-2*I%-bwidth%, dy%-2*I%-bwidth%
WHEN 1:
ELLIPSE x%, y%, dx%-bwidth%/2-I%, dy%-bwidth%/2-I%
ELLIPSE x%, y%, dx%-bwidth%/2+I%, dy%-bwidth%/2+I%
ENDCASE
r-=l:g-=m:b-=n :REM Adjust colors
NEXT
COLOUR 0,0,0,0 :GCOL oldgcol&
IF pen% VDU 23,23,pen%|
ENDPROC
With PROCgradcylZ the gradient is across the smaller axis. If you want it across the other axis you will have to adapt the code, which is pretty easy.
Re: RETROLIB 10 REFERENCE +FNgkey tool
Post by michael on Jan 23rd, 2017, 12:00am
Nice work. Have you worked out light perspective on a sphere yet?
Say I wanted to have different light angles for a rolling ball?
Perhaps pool ball animations?
( I have created such a tool but its not on a presentation..)
Re: RETROLIB 10 REFERENCE +FNgkey tool
Post by michael on Jan 23rd, 2017, 1:42pm
On a side note. If we reflect on what has been achieved, we are creating a new foundation for controls. Non windows based. It has been a pet project for me for a very long time.
I really think we could create a tool box for creating objects for D3D.
Premade resizable objects.
We could make a program generator that automatically creates the code for additional constructs as they are done.
Ric you out there?