10-11-2023, 04:06 PM
have some gridpaper
Code: (Select All)
'GridPaper .... based on yellowpaper.bas by Dav, OCT/2023
'$dynamic
Screen _NewImage(800, 600, 32)
Dim Shared dot&
dot& = _NewImage(1, 1, 32) 'ALL rotoline routines need this defiend
Dim a(1, 2)
'Here's where you can load another font you want to use....
'fnt& = _LOADFONT("lucon.ttf", 24, "monospace")
'_FONT fnt&
'Call the SUB, with your title$ message
GridPaper "GridPaper for John's QB64-PE Code Notebook"
'You need to call below so PRINTing text doesn't destroy background.
_PrintMode _KeepBackground
'=== show some sample information....
Color _RGB(64, 64, 64)
For y = 5 To 16
Locate y, 2: Print Date$;
Locate , 16: Print "Random Data ="; Rnd; RN;
Next: Print
'Use location 2 to print in left column, 16 for printing in the text lines.
Print
Locate , 16: Print "This is another line."
Print
Locate , 2: Print "Plotting:"
Locate 21, 5: Print "x=35, y=10"
Locate , 5: Print "x=35, y=18"
Locate , 5: Print "x=40, y=18"
Locate , 5: Print "x=45, y=8"
Locate , 5: Print "x=35, y=10"
'define a shape to draw, all the units are in grid squares
cx = 30: cy = 12
sides = 12: rstep = 360 / sides: rad = 4: r = 0
ReDim a(sides + 1, 2)
For p = 1 To sides + 1 'i want to draw closed polygon
a(p, 1) = cx + (rad * Cos(0.01745329 * r))
a(p, 2) = cy + (rad * Sin(0.01745329 * r))
r = r + rstep
Next p
griddraw a(), 2, _RGB32(100, 0, 0)
ReDim a(5, 2)
a(1, 1) = 35: a(1, 2) = 10
a(2, 1) = 35: a(2, 2) = 18
a(3, 1) = 40: a(3, 2) = 18
a(4, 1) = 45: a(4, 2) = 8
a(5, 1) = 35: a(5, 2) = 10
griddraw a(), 3, _RGB32(0, 100, 0)
Sleep
Sub GridPaper (title$)
'This SUB draws a gridpapersheet scaled to fit current font settings.
'It also prints and centers title$ in the top title area.
fw = _FontWidth: fh = _FontHeight 'get current font width/height settings
'(the fw & fh we will use to calculate LINE drawing so they line up right with PRINT)
Cls , _RGB(252, 252, 255) 'clear screen to faded off white
'draw the vertical lines, to make column/text area
'have to set x to follow fh so the grid squares are squares
For x = fh - 1 To _Width Step fh
Line (x, 0)-(x, _Height), _RGB(200, 200, 255)
Next x
'draw the text lines to bottom of screen
For y = fh - 1 To _Height Step fh
Line (0, y)-(_Width, y), _RGB(200, 200, 255)
Next
'draw top brown tile area (remove this if not wanted)
' Line (0, 0)-(_Width, fh * 3), _RGB(102, 19, 15), BF '<< enough for 3 lines
' Color _RGB(255, 255, 0)
'Next we print title$, centering the text in the top area
'For this we need to calcuale how many letters fit on one line, INT(_WIDTH/fw) / 2.
'I divided that by 2 to find the center spot on the line.
'So, subtract half of the title$ length from that spot to make it centered nice.
'Locate 2, Int((_Width / fw) / 2) - Int(Len(title$) / 2)
'Now we PRINT the text, but we need to print a certain way so the background isn't
'messed up. We will use _PRINTMODE _KEEPBACKGROUND to do that.
'First, let's save the current printmode so we can restore that when SUB is done.
pmode = _PrintMode
_PrintMode _KeepBackground
Color _RGB32(1, 1, 1)
_PrintString (_Width / 2 - (_PrintWidth(title$) / 2), fh), title$ 'finally, PRINT the title$
'All done, so let's restore previous printmode setting
If pmode = 1 Then _PrintMode _KeepBackground
If pmode = 2 Then _PrintMode _OnlyBackground
If pmode = 3 Then _PrintMode _FillBackground
End Sub
Sub griddraw (a(), thk, klr As _Unsigned Long)
'drawa an array of points scaled to the grid
gs = _FontHeight
maxp = UBound(a)
For p = 1 To maxp - 1
RotoLine a(p, 1) * gs, a(p, 2) * gs, a(p + 1, 1) * gs, a(p + 1, 2) * gs, thk, klr
Next p
End Sub
Sub RotoLine (x1 As Single, y1 As Single, x2 As Single, y2 As Single, thk As Single, klr As _Unsigned Long)
'use rotozoom to draw a line of thickness thk of color klr from x1,y1 to x2,y2
cx = (x1 + x2) / 2
cy = (y1 + y2) / 2
o& = _Dest
_Dest dot&
PSet (0, 0), klr
_Dest o&
rtn = DegTo!(x1, y1, x2, y2)
lnth = Sqr(Abs(x2 - x1) * Abs(x2 - x1) + Abs(y2 - y1) * Abs(y2 - y1))
RotoZoom23d cx, cy, dot&, lnth, thk, rtn
End Sub
Sub RotoZoom23d (centerX As Single, centerY As Single, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
'rotate an image with Rotation defined in units of degrees, 0 is along x axis to the right gogin clockwise
Dim px(3) As Single: Dim py(3) As Single
Wi& = _Width(Image&): Hi& = _Height(Image&)
W& = Wi& / 2 * xScale
H& = Hi& / 2 * yScale
px(0) = -W&: py(0) = -H&: px(1) = -W&: py(1) = H&
px(2) = W&: py(2) = H&: px(3) = W&: py(3) = -H&
sinr! = Sin(-0.01745329 * Rotation): cosr! = Cos(-0.01745329 * Rotation)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, Hi& - 1)-(Wi& - 1, Hi& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(Wi& - 1, 0)-(Wi& - 1, Hi& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
Function DegTo! (x1, y1, x2, y2)
' returns an angle in degrees from point x1,y1 to point x2,y2
DegTo! = _Atan2((y2 - y1), (x2 - x1)) / 0.01745329
End Function