BBC BASIC for Windows
« RETROLIB 10 + REFERENCE MOD March 2018 »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 10:00pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

If you require a dump of the post on your message board, please come to the support board and request it.


Thank you Conforums members.

BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1 2 3  Notify Send Topic Print
 veryhotthread  Author  Topic: RETROLIB 10 + REFERENCE MOD March 2018  (Read 2414 times)
michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
lamp RETROLIB 10 + REFERENCE MOD March 2018
« Thread started 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

 

« Last Edit: Mar 15th, 2018, 05:17am by michael » User IP Logged

I like making program generators and like reinventing the wheel
Zaphod
Guest
lamp Re: RETROLIB 3 link -try it out
« Reply #1 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
« Last Edit: Dec 21st, 2016, 9:24pm by Zaphod » User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
lamp Re: RETROLIB 3 link -try it out
« Reply #2 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.

User IP Logged

I like making program generators and like reinventing the wheel
Zaphod
Guest
lamp Re: RETROLIB 4 -exercise and demo button
« Reply #3 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
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
lamp Re: RETROLIB 4 -exercise and demo button
« Reply #4 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
User IP Logged

I like making program generators and like reinventing the wheel
Zaphod
Guest
lamp Re: RETROLIB 4 -exercise and demo button
« Reply #5 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
« Last Edit: Dec 22nd, 2016, 3:13pm by Zaphod » User IP Logged

Zaphod
Guest
lamp Re: RETROLIB 4 -exercise and demo button
« Reply #6 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
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
lamp Re: RETROLIB 5- many more demos and improvements
« Reply #7 on: Dec 22nd, 2016, 5:36pm »

OOOPS !! Sorry about that !! Its fixed..

User IP Logged

I like making program generators and like reinventing the wheel
Zaphod
Guest
lamp Re: RETROLIB 6- here is your Christmas tree
« Reply #8 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
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
lamp Re: RETROLIB 6- here is your Christmas tree
« Reply #9 on: Dec 22nd, 2016, 10:26pm »

Quote:
I can't keep up!




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.
« Last Edit: Dec 22nd, 2016, 10:39pm by michael » User IP Logged

I like making program generators and like reinventing the wheel
Zaphod
Guest
lamp Re: RETROLIB 6- here is your Christmas tree
« Reply #10 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
« Last Edit: Dec 23rd, 2016, 8:41pm by Zaphod » User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
lamp Re: RETROLIB 6- here is your Christmas tree
« Reply #11 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.

« Last Edit: Dec 24th, 2016, 12:50am by michael » User IP Logged

I like making program generators and like reinventing the wheel
Zaphod
Guest
lamp Re: RETROLIB 6- here is your Christmas tree
« Reply #12 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?
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
lamp Re: RETROLIB 6- here is your Christmas tree
« Reply #13 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.


« Last Edit: Dec 24th, 2016, 01:31am by michael » User IP Logged

I like making program generators and like reinventing the wheel
Zaphod
Guest
lamp Re: RETROLIB 6- here is your Christmas tree
« Reply #14 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
User IP Logged

Pages: 1 2 3  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls