|
Post by B+ on Jan 2, 2020 4:19:05 GMT
'Ascii Fireworks with Mainscreen Commands for Graphics Window.txt for JB B+ 2020-01-01 ' 2020-01-02 tsh73 adds nice gravity effect! ' 2020-01-02 escape now quits ' 2020-01-02 now with trails ' ' PLUS Color!!! Plus the print is a little bigger for us older folks.
' Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr
'Then use you can use these command substitutes for the graphics window: ' locate = call locateG characterColumn, characterRow ' print = call printG text$ '(strings only) ' input = call inputG prompt$, variable$ '(string variable only) ' color = call colorG fore$, back$ 'takes only string arguments ' for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15 ' cls = call clsG 'clears to last colorG fore$, back$ used ' PLUS inkee$ is a global variable you have access to use like QB inkey$
' finish your code section with a wait command
call setup "ASCII Fireworks with Main Window Commands for Graphic Windows", 1200, 720 '100 x 30? characters check global nR, t$, PI, maxCol, maxRow '<<< maxRow??? maxCol??? WTH why doesn't Globals in Setup work??????????????? maxRow = 30 maxCol = 100 PI = 3.141592 nR = 5 t$ = " Happy New Year Just Basic Forum, ASCII Fireworks Brought To You By Bplus Inspired By Recent Efforts at QB64 Forum, Gravity Effect by tsh73, Go In Peace 2020..."
DIM x(nR), y(nR), bang(nR), age(nR), c(nR) FOR i = 1 TO nR call new i 'print x(i), y(i), bang(i), age(i), c(i) NEXT
while asc(inkee$) <> 27 scan call clsG call colorG QBcolr$(13), QBcolr$(0) lc = lc + 1 IF lc MOD 5 = 0 THEN p = (p + 1) MOD LEN(t$) call locateG .25 * maxCol, 2 s$ = mid$(t$, p+1, int(.5 * maxCol)) call printG s$ rocs = rocs + 1 IF rocs > nR THEN rocs = nR FOR i = 1 TO rocs call drawRocket i NEXT call pause 40 wend wait
SUB new i x(i) = INT(RND(1) * (maxCol - 20)) + 10 y(i) = maxRow - 1 bang(i) = INT(RND(1) * (maxRow - 10)) age(i) = 0 c(i) = INT(RND(1) * 15) + 1 END SUB
SUB drawRocket i IF y(i) > bang(i) THEN call colorG QBcolr$(15), QBcolr$(0) call locateG x(i), y(i) call printG "^" y(i) = y(i) - 1 ELSE age(i) = age(i) + 1 IF age(i) > 25 THEN call new i ELSE call colorG QBcolr$(c(i)), QBcolr$(0) if age(i) > 4 then start = age(i) - 4 else start = 1 for a = start to age(i) 'a = age(i) FOR j = 1 TO 12 xx = x(i) + 1 * a * COS(j * PI / 6) yy = y(i) + .5 * a * SIN(j * PI / 6) yy = yy + (y(i) - a) ^ 2 / 15 '<<<< tsh73 gravity IF xx > 0 AND xx < maxCol AND yy > 0 AND yy < maxRow THEN call locateG xx, yy call printG "*" END IF NEXT next END IF END IF END SUB
wait ' end code input section ==========================
' Copy Paste these Procedures so you can do a graphics setup
' Use: setup title$, desiredWidth, desiredHeight 'to setup a graphics window #gr 'Then use you can use these command substitutes for the graphics window: ' locate = call locateG characterColumn, characterRow ' print = call printG text$ '(strings only) ' input = call inputG prompt$, variable$ '(string variable only) ' color = call colorG fore$, back$ 'takes only string arguments ' for colors I set up function QBcolr$(colrNum) to return QB color string for numbers 0 to 15 ' cls = call clsG 'clears to last colorG fore$, back$ used ' PLUS inkee$ is a global variable you have access to use like QB inkey$
' finish your code section with a wait command
'setup graphics window with specified title$, width and height with handle #gr, AKA h$ sub setup title$, wWidth, wHeight global xmax, ymax 'screen width and height xmax = wWidth : ymax = wHeight '<<<<<< set this as you need or from plug-in notes
global cellW, cellH 'do not mess with cellW and cellH globals for printing cellW = 12 'pixels wide for characters cellH = 24 'pixels high for characters
global maxRow, maxCol 'and then these are calculated from above globals maxCol = int(xmax / cellW) 'these control printing characters maxRow = int(ymax / cellH)
global lastC, lastR 'for LocateG (locate), printG (print a line), lp (locate and print) lastC = 1 : lastR = 1
'key events update globals with latest info global inkee$, h$
h$ = "#gr"
global wFG$, wBG$ wFG$ = "white" : wBG$ = "black"
nomainwin
WindowWidth = xmax + 8 WindowHeight = ymax + 32 UpperLeftX = (DisplayWidth-WindowWidth) / 2 UpperLeftY = (DisplayHeight-WindowHeight) / 2
open title$ for graphics_nsb_nf as #gr #gr "trapclose quit"
'fonts that don't work arial, tahoma, verdana '#gr "font arial ";cellW;" ";cellH '#gr "font dejavu_sans_mono ";cellW;" ";cellH
'fonts that work '#gr "font courier_new ";cellW;" ";cellH #gr "font consolas ";cellW;" ";cellH
'#gr "home" '< check drawing area '#gr "posxy w2 h2" '<<<<<<<<<<<<<<<<<< 'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;", Height (h2*2) = ";h2*2
#gr "setfocus" #gr "when characterInput charIn" #gr "down" call colorG "white", "black" call clsG end sub
sub printG mess$ 'print (with "line feed") for graphics window startR = lastR for i = 1 to len(mess$) scan call lp lastC, lastR, mid$(mess$, i, 1) if lastR <> startR then exit for next lastC = 1 lastR = startR + 1 if lastR > maxRow then lastR = maxRow 'yuck! end sub
sub clsG 'cls for graphics window #gr "fill ";wBG$ lastC = 1 : lastR = 1 end sub
sub colorG fore$, back$ 'set color fore and back to color string names, see QBcolr$ function wFG$ = fore$ : wBG$ = back$ #gr "color ";wFG$ #gr "backcolor ";wBG$ end sub
sub locateG x, y 'locate xColumnCell, yRowCell for printing if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then lastC = x lastR = y end if end sub
sub inputG prmpt$, byref var$ 'input for a graphics screen 'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1
inkee$ = "" 'clear last key (new fix for DE5) call lp lastC, lastR, prmpt$;"{" 'this will update lastR and lastC to the starting point of input variable pRow = lastR : pCol = lastC 'save these for redrawing var call lp pCol, pRow, "}" OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz" OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/" do scan if instr(OK$, inkee$) then if inkee$ = Chr$(8) then if t$ <> "" then if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1) end if else if inkee$=Chr$(13) or inkee$=Chr$(27) then 'new D5, I was expecting nothing in return for my esc if inkee$ = chr$(27) then t$ = "" exit do else t$=t$;inkee$ end if end if call lp pCol, pRow, t$;"} " inkee$ = "" end if loop until done var$ = t$ lastC = 1 : lastR = pRow + 1 end sub
function QBcolr$(colrNum) select case colrNum case 0 : QBcolr$ = "black" case 1 : QBcolr$ = "darkblue" case 2 : QBcolr$ = "brown" case 3 : QBcolr$ = "darkcyan" case 4 : QBcolr$ = "darkred" case 5 : QBcolr$ = "darkpink" case 6 : QBcolr$ = "darkgreen" case 7 : QBcolr$ = "lightgray" case 8 : QBcolr$ = "darkgray" case 9 : QBcolr$ = "blue" case 10 : QBcolr$ = "green" case 11 : QBcolr$ = "cyan" case 12 : QBcolr$ = "red" case 13 : QBcolr$ = "pink" case 14 : QBcolr$ = "yellow" case 15 : QBcolr$ = "white" end select end function
function rndColor$() rndColor$ = QBcolr$( int( rnd(0) * 16) ) end function
sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print 'if locate = x col and y row then and top left corner locates as 1, 1 c = x - 1: r = y if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then #gr "place ";c * cellW;" ";r * cellH - 4 #gr "|";mess$ lastC = x + len(mess$) if lastC > maxCol then lastC = 1 : lastR = lastR + 1 if lastR > maxRow then lastR = maxRow 'yuck! end if end sub
sub cp y,cpText$ 'cp Center Print on line y the cpText$ call lp int((maxCol - len(cpText$))/2 + 1.5), y, cpText$ lastC = 1 : lastR = y + 1 end sub
sub at xPix, yPix, char$ 'print a string at pixel x, y This pin point locating. #gr "place ";xPix;" ";yPix #gr "|";char$ end sub
sub pause mil 'tsh version has scan built-in t0 = time$("ms") while time$("ms") < t0 + mil : scan : wend end sub
sub charIn hdl$, c$ inkee$ = c$ end sub
sub quit hdl$ timer 0 close #gr end end sub
|
|
|
Post by tsh73 on Jan 2, 2020 9:10:17 GMT
Happy New Year! Thanks, B+!
|
|
|
Post by cundo on Jan 2, 2020 12:40:10 GMT
Have a great 2020!!
|
|
|
Post by Rod on Jan 2, 2020 14:19:20 GMT
Very cool fireworks, thanks
|
|
|
Post by tsh73 on Jan 2, 2020 15:16:58 GMT
some gravity added, so sparkles goes parabola
yy =yy +(bang(i)-age(i))^2/15
(put it just after
yy = y(i) + .5 * age(i) * SIN(j * PI / 6)
)
|
|
|
Post by B+ on Jan 2, 2020 15:57:14 GMT
some gravity added, so sparkles goes parabola yy =yy +(bang(i)-age(i))^2/15
(put it just after yy = y(i) + .5 * age(i) * SIN(j * PI / 6)
Fabulous! I tried and failed to add that effect, forgot about the cumulative effect I think. Code in Original Post has been updated with that change, thanks!
|
|
|
Post by B+ on Jan 2, 2020 16:40:34 GMT
OK more updates to original code, now with trails...
|
|
ntech
Junior Member
Posts: 99
|
Post by ntech on Jan 2, 2020 21:08:15 GMT
Happy New Year!
|
|