BBC BASIC for Windows
« Unlimited Role playing interface tool »

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



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  Notify Send Topic Print
 thread  Author  Topic: Unlimited Role playing interface tool  (Read 217 times)
michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


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

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$
 
User IP Logged

I like making program generators and like reinventing the wheel
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