BBC BASIC
« Unlimited Role playing interface tool »

Welcome Guest. Please Login or Register.
Mar 31st, 2018, 11:11pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
We apologize Conforums does not have any export functions to migrate data.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

Thank you Conforums members.
Cross-platform BBC BASIC (Windows, Linux x86, Mac OS-X, Android, iOS, Raspberry Pi)
BBC BASIC Resources
BBC BASIC Help Documentation
BBC BASIC for Windows Home Page
BBC BASIC Programmers' Reference
BBC BASIC Beginners' Tutorial
BBC BASIC for SDL 2.0 Home Page
BBC BASIC Discussion Group

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Unlimited Role playing interface tool  (Read 214 times)
michael
Full Member
ImageImageImage


member is offline

Avatar




PM


Posts: 157
xx Unlimited Role playing interface tool
« Thread started on: Aug 22nd, 2017, 01:50am »

You will see 2 squares. If you use your mouse left button on each it will highlight the box and tell you which one you pressed. This tool can effectively be used for endless location interactions with mouse and echoes the com$ value back to the user of the function.

This can be used for inventory in bags and looting display selection for gold and armor or other items.
Code:
      PROCgraphics(1100,400)      res$=""      res=0      ls= 0      LET rs= 24      counl%=290      counr%=2110      REM setup buttons before use      res$=FNabutton(100,100,"black","fill"):REM keeping it efficient      res$=FNabutton(200,100,"black","fill")      PROCcolor("f","black")      REM TRACKING STARTS HERE      REPEAT        res$=""        IF FNabutton(100,100,"green","left")="left" THEN res$="left"        IF FNabutton(200,100,"blue","right")="right" THEN res$="right"        PROCsbox(250,700,2150,600,"15")        MOVE 260,650:PRINT res$        WAIT 10      UNTIL FALSE      END      DEFFNabutton(x,y,c$,com$):REM x,y is lower left and c$=fillcolor:com$-command      MOUSE mx,my,mb      LOCAL ret$      PROCcolor("f","4")      PROCrect(x,y,x+50,y+50)      IF com$="fill" THEN        PROCpaint(x+5,y+5,c$)      ENDIF      IF mx>x AND mx<x+50 AND my>y AND my<y+50 THEN        PROCcolor("f","15"):PROCrect(x,y,x+50,y+50)        IF mb=4 THEN ret$=com$      ENDIF      =ret$      DEFPROCarrowu(x,y)      PRIVATE xx,yy      PROCcolor("f","black")      LINE xx,yy,xx-20,yy-20      LINE xx,yy,xx+20,yy-20      PROCcolor("f","15")      LINE x,y,x-20,y-20      LINE x,y,x+20,y-20      xx=x:yy=y      ENDPROC      DEFPROCarrowd(x,y)      PRIVATE hh,vv      PROCcolor("f","000,000,000")      LINE hh,vv,hh-20,vv+20      LINE hh,vv,hh+20,vv+20      PROCcolor("f","15")      LINE x,y,x-20,y+20      LINE x,y,x+20,y+20      hh=x:vv=y      ENDPROC      REM  GRAPHICS(x,y)      DEF PROCgraphics(x,y)      VDU 23,22,x;y;8,15,16,1      OFF      VDU 5      ENDPROC      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$)      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      DEFPROCpaint(x%,y%,co$)      PROCcolor("b","0"):PROCcolor("f",co$)      FILL x%,y%      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      a      REM buttonz      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$=""      =st$ 
« Last Edit: Aug 22nd, 2017, 01:52am by michael » User IP Logged

I like reinventing the wheel, but for now I will work on tools for D3D
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

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