Author |
Topic: Challenge: Line up the time gauge !! (Read 314 times) |
|
michael
Full Member
member is offline
Posts: 157
|
 |
Challenge: Line up the time gauge !!
« Thread started on: Aug 6th, 2017, 4:59pm » |
|
The two specially designed arrows move (not like clockwork) towards each other. For each 1/2 hour it must line up with a number or a break point.
Is there someone who thinks they can make this work correctly before I do it?
Rules:
* It must be equal time jumps for each direction
* arrows must stay within boundaries
Good luck.. First successful responder is the champion !!
Code: PROCgraphics(1100,600) ls%= 0 rs%= 24 coun%=0 LET top%=130 LET bottom%=2140 PROCsbox(10,700,2150,600,"15") PROCcolor("f","black") MOVE 100,650 PRINT " 12 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12" REM TRACKING STARTS HERE REPEAT PROCarrowu(bottom%-coun%,590) PROCarrowd(top%+coun%,710) MOVE 0,0 WAIT 100 coun%=coun%+38 UNTIL coun%>2000 END 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",FNrgb(x%,y%)):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 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 REM used by PROCpr to enhance clean up from text overlays 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 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$="" MOVE 0,0 REM hide that thing =st$ |
|
 Logged
|
I like reinventing the wheel, but for now I will work on tools for D3D
|
|
|
michael
Full Member
member is offline
Posts: 157
|
|
Re: Challenge: Line up the time gauge !!
« Reply #1 on: Aug 6th, 2017, 5:56pm » |
|
TIME UP !! Here is the solution:
Only took me an hour.
I WIN !!
* and for a side note all my computers and entertainment equipment are powered by solar. (6 x 85 watt solar panels.) (had them since 2002)
BBC Basic is solar powered.
Code: PROCgraphics(1100,600) ls%= 0 rs%= 24 coun%=0 LET top%=290 LET bottom%=2110 PROCsbox(10,700,2150,600,"15") PROCcolor("f","black") MOVE 100,650 PRINT " 12 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12" REM TRACKING STARTS HERE REPEAT PROCarrowu(bottom%-coun%,590) PROCarrowd(top%+coun%,710) MOVE 0,0 WAIT 100 coun%=coun%+38 UNTIL coun%>1838 END 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",FNrgb(x%,y%)):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 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 REM used by PROCpr to enhance clean up from text overlays 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 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$="" MOVE 0,0 REM hide that thing =st$
|
| « Last Edit: Aug 6th, 2017, 9:23pm by michael » |
Logged
|
I like reinventing the wheel, but for now I will work on tools for D3D
|
|
|
hellomike
Junior Member
member is offline
Gender: 
Posts: 55
|
|
Re: Challenge: Line up the time gauge !!
« Reply #2 on: Aug 7th, 2017, 10:37am » |
|
Congrats!
|
|
Logged
|
|
|
|
|
