|
Post by plus on Dec 31, 2022 23:05:23 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$ = " Good bye 2022 Happy New Year Just Basic Forum Hello 2023! " 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 mid$("2023", a - start + 1, 1) 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 1, 2023 21:35:20 GMT
|
|
|
Post by plus on Jan 1, 2023 21:54:46 GMT
Decided to blank out last flame and redraw new instead of blanking whole screen, plus made longer streams to 2023...
'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$ = " Good bye 2022 Happy New Year Just Basic Forum Hello 2023! " 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
rocs = rocs + 1 IF rocs > nR THEN rocs = nR FOR i = 1 TO rocs call drawRocket i NEXT 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$ call pause 60 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 locateG x(i), y(i)+1 call printG " " end if IF y(i) > bang(i) THEN call colorG QBcolr$(15), QBcolr$(0) call locateG x(i), y(i) + 1 call printG " " call locateG x(i), y(i) call printG "^" y(i) = y(i) - 1 ELSE 'blank out last set call colorG QBcolr$(c(i)), QBcolr$(0) for a = 1 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 age(i) = age(i) + 1 IF age(i) > 18 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 = 1 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 if a >= start then call printG mid$("2023", a - start + 1, 1) else call printG "*" end if 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
|
|