There are some here who work with Linux. My favorite editor on the command line has always been Vim (on KDE it was jedit). Today I only have WSL2 under Windows, as a hobby.
You can customize Vim for each programming language if you want. In case anyone is interested, my source code in Vim looks the same under WSL2 as it used to under SuSE, namely like this (GCC):
The settings in the .exrc and .vimrc look like this. They have to be filed separately in each sub-forum - that is, for each programming language.
Option _Explicit
_Title "Laser Blades" 'b+ 2023-07-24 another way to do laser beams
Const NBolts = 50 ' max number of Bolt slots available, just like bullet science
Const PulseLength = 150 ' length of light pulses as they travel down BoltLine
Type BoltType 'see NewBolt for description of these variables
As Single x1, y1, r1, dx, dy, dr, d, ang, frames, frame, active, speedX, speedY, x, y, r
As _Unsigned Long k
End Type
Dim Shared Bolts(1 To NBolts) As BoltType
Dim Shared bk
Dim As Long mx, my, i, lpc, blastedShip, r
makeBackground
Do
Cls
_PutImage , bk, 0
If blastedShip Then
DrawShip 600, 350, &HFF00CC66
For r = blastedShip To 1 Step -2
FCirc 600, 350, r, _RGB32(5 * (50 - r), 5 * (50 - r), 0, 20)
Next
blastedShip = blastedShip + 2
If blastedShip > 50 Then blastedShip = 0
Else
DrawShip 600, 350, &HFF00CC66 ' bplus signature space ship, for rent :)
End If
' fire off some more bolts at the ship from the screen corners!
If lpc = 0 Then
If Rnd < .7 Then NewBolt 0, 0, 1, 600, 350, 20, 3, &HCCFF0000
ElseIf lpc = 30 Then
If Rnd < .7 Then NewBolt _Width - 1, 0, 1, 600, 350, 25, 2, &HCC007700
ElseIf lpc = 60 Then
If Rnd < .7 Then NewBolt _Width - 1, _Height - 1, 1, 600, 350, 30, 3, &HCCFF00FF
ElseIf lpc = 90 Then
If Rnd < .7 Then NewBolt 0, _Height - 1, 1, 600, 350, 35, 2, &HCC008888
End If
lpc = (lpc + 1) Mod 120 ' loopscounter every 30 shoot from a corner
For i = 1 To NBolts
If Bolts(i).active Then DrawBolt (i) ' draws the bolts still active
Next ' according to what frame they are on
' collision detection blow up when ship is hit
For i = 1 To NBolts
If Bolts(i).active Then
If _Hypot(Bolts(i).x - 600, Bolts(i).y - 350) < 20 + Bolts(i).r Then
If Bolts(i).x1 <> 600 And Bolts(i).y1 <> 350 Then ' oops watch out for friendly fire!!!
If blastedShip = 0 Then blastedShip = 1
Bolts(i).active = 0
End If
End If
End If
Next
While _MouseInput: Wend
mx = _MouseX: my = _MouseY
If _MouseButton(1) Then
NewBolt 600, 340, 1, mx, my, 25, 10, _RGB32(255, 255, 0, 180)
_Delay .25
End If
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewBolt (x1, y1, r1, x2, y2, r2, ppfSpeed, k~&) ' sets up for the DrawBolt Sub
'x1, y1, r1 = location and radius at start of beam
'x2, y2, r2 = target location and radius at beam end
'ppfSpeed = how many pixels per frame in main loop to transverse
Dim i
For i = 1 To NBolts
If Bolts(i).active = 0 Then
Bolts(i).x1 = x1 ' start x, y, radius
Bolts(i).y1 = y1
Bolts(i).r1 = r1
Bolts(i).active = 1 ' bolt is activated
Bolts(i).dx = x2 - x1 ' drawing the bolt line and thickness
Bolts(i).dy = y2 - y1 ' as it changes from x1, y1, r1 to x2, y2, r2
Bolts(i).dr = r2 - r1
Bolts(i).d = _Hypot(Bolts(i).dx, Bolts(i).dy) ' distance of the bolt line
Bolts(i).frames = Int(Bolts(i).d / ppfSpeed) + 1 ' divide that distance by pulse = PulseLength
Bolts(i).frame = 1 ' set the frame you are on to locate the pulse in drawing
Bolts(i).ang = _Atan2(y2 - y1, x2 - x1)
Bolts(i).speedX = ppfSpeed * Cos(Bolts(i).ang)
Bolts(i).speedY = ppfSpeed * Sin(Bolts(i).ang)
Bolts(i).x = x1 ' track leading x, y, r of current bolt for collision detection
Bolts(i).y = y1
Bolts(i).r = r1
Bolts(i).k = k~&
Exit Sub
End If
Next
End Sub
Sub DrawBolt (idx) ' needs FCirc (Fill Circle) routine
' This sub draw a pulse of light on the BoltLine from .x1, .y1 on the way to .x2, .y2
' The start radius is .r1 and the end radius is .r2 and the pulse is thinned or thickened
' as it proceeds down the boltLine.
'All this is setup in the NewBolt Sub and uses DIM Shared Bolts() as BoltType and Constants
' NBolts = max amount of activated Bolt "slots" available and PulseLength the length of
' BoltLine sections to draw in each frame.
'2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
Sub FCirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub DrawShip (x, y, colr As _Unsigned Long) 'needs FCirc and FEllipse subs
Static ls ' tracks the last light position in string of lights
Dim light As Long, r As Long, g As Long, b As Long
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
FEllipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
FEllipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
FEllipse x, y, 30, 7, _RGB32(r, g, b)
For light = 0 To 5
FCirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
Next
ls = ls + 1
If ls > 5 Then ls = 0
End Sub
Sub FEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Sub makeBackground
bk = _NewImage(_Width, _Height, 32)
_Dest bk
Dim As Long i, stars, horizon
For i = 0 To _Height
Line (0, i)-(_Width, i), _RGB32(70, 60, i / _Height * 160)
Next
stars = _Width * _Height * 10 ^ -4
For i = 1 To stars 'stars in sky
PSet (Rnd * _Width, Rnd * _Height), _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * _Width, Rnd * _Height, 1, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * _Width, Rnd * horizon, 2, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
_PutImage , 0, bk
_Dest 0
End Sub
working on a larger image generation projects and realized a little piece of it looked like crop circles, so here we go with a goofy low end crop circle demo:
Code: (Select All)
'crop circles version 0.1
'by James D. Jarvis, July 2023
'this is modifed from a larger image generation program I am working on so if you read the code some of thsi is goign to be strange
'there are likely stubs and variables not actually used in the cropcircle generation that are used in the original, but it works for a goofy little demo
ymax = 800
xmax = 800
'$dynamic
Screen _NewImage(xmax, ymax, 32)
Dim flrklr As _Unsigned Long
tilescale = 4
Type roomtype
fill As Integer
rx As Integer
ry As Integer
nw As Integer
sw As Integer
ew As Integer
ww As Integer
cnx As Integer
End Type
Dim Shared rm(0) As roomtype
Dim Shared floorklr As _Unsigned Long
Dim Shared wallklr As _Unsigned Long
Dim Shared emptyklr As _Unsigned Long
floorklr = _RGB32(220, 220, 0)
wallklr = _RGB32(50, 50, 50)
emptyklr = _RGB32(80, 200, 15)
Type band_type
rad As Integer
s As Integer
e As Integer
spoke As Integer
thk As Single
End Type
Dim Shared band(0) As band_type
Dim Shared oring(0) As band_type
Dim Shared tessfix
Dim Shared roomfix, excludeturrets
Dim Shared fillcellchance, defaulthallwidth
Dim Shared bumpchance, antennachance
bumpchance = 20
antennachance = 60
floorgrid = 0
forcegeneration = 0
linkgeneration = 0
tessfix = 0
roomfix = 0
fillcellchance = 50
firstpass = 1
Cls
Do
If (Rnd * 101) < fillcellchance Then
rm(r).fill = Int(1 + Rnd * 10) * (tilescale / 2)
Else
rm(r).fill = 0
End If
If rm(r).fill = 0 Then
' Circle (rm(r).rx, rm(r).ry), rm(r).nw, floorklr
fatarc rm(r).rx, rm(r).ry, 2, rm(r).nw, 0, 359, floorklr
Else
fcirc rm(r).rx, rm(r).ry, rm(r).fill, floorklr
End If
Next r
lastcount = roomcount
Next b
For n = 1 To k
rs = band(c - 1).s: re = band(c - 1).e
bsiz = re - rs
ang = Int(rs + Rnd * bsiz)
ppx1 = cx + band(c - 1).rad * Cos(0.01745329 * ang)
ppy1 = cy + band(c - 1).rad * Sin(0.01745329 * ang)
ppx2 = cx + band(c).rad * Cos(0.01745329 * ang)
ppy2 = cy + band(c).rad * Sin(0.01745329 * ang)
fatline ppx1, ppy1, ppx2, ppy2, 2, floorklr
Next
End If
If c = cb Then
rs = band(c).s: re = band(c).e
bsiz = re - rs
ang = -1 * Int(rs + Rnd * bsiz)
fx = 0
fy = 0
ppx2 = cx + band(c).rad * Cos(0.01745329 * ang)
ppy2 = cy + band(c).rad * Sin(0.01745329 * ang)
cc = cb
Do
cc = cc - 1
xc = cx + band(cc).rad * Cos(0.01745329 * ang)
yc = cy + band(cc).rad * Sin(0.01745329 * ang)
If Point(xc, yc) <> emptyklr Then
fx = xc
fy = yc
End If
Loop Until fx <> 0 And fy <> 0 Or cc = 1
If fx = 0 Then
fx = cx
fy = cy
rs = band(1).s: re = band(1).e
bsiz = re - rs
ang = Int(rs + Rnd * bsiz)
tx = cx + band(1).rad * Cos(0.01745329 * ang)
ty = cy + band(1).rad * Sin(0.01745329 * ang)
fatline cx, cy, tx, ty, 2, floorklr
End If
fatline fx, fy, ppx2, ppy2, 2, floorklr
End If
Next c
For a = 1 To 5
If Rnd * 100 < antennachance Then
tb = Int(1 + Rnd * cb)
rs = band(tb).s: re = band(tb).e
bsiz = re - rs
bangle = Int(rs + Rnd * bsiz)
DB = mr + 20
dx = cx + DB * Cos(0.01745329 * bangle)
dy = cy + DB * Sin(0.01745329 * bangle)
ppx2 = cx + band(tb).rad * Cos(0.01745329 * bangle)
ppy2 = cy + band(tb).rad * Sin(0.01745329 * bangle)
fatline dx, dy, ppx2, ppy2, 2, floorklr
Select Case Int(1 + Rnd * 16)
' Select Case 14
Case 1, 2
fcirc dx, dy, Int(5 + Rnd * 10), floorklr
Case 3, 4, 5, 6, 7, 8
fangs = bangle - Int(2 + Rnd * 10)
fange = bangle + Int(2 + Rnd * 10)
bd = Int(1 + Rnd * 5) * tilescale
For d = 0.5 To bd Step 0.5
fatarc cx, cy, 2, DB + d, fangs, fange, floorklr
Next d
Case 10, 11, 12
fanga = Int(2 + Rnd * 10) * 10
bd = Int(2 + Rnd * 10) * tilescale
For da = bangle - fanga To bangle + fanga
DB = mr + 20
nx = dx + bd * Cos(0.01745329 * da)
ny = dy + bd * Sin(0.01745329 * da)
fatline dx, dy, nx, ny, 2, floorklr
Next da
Case 13, 14, 15, 16
orrc = Int(2 + Rnd * 3)
ReDim oring(orrc) As band_type
r2 = 0
For o = 1 To orrc
r2 = r2 + Int(2 + Rnd * 2) * tilescale
oring(o).rad = r2
oring(o).s = 0
oring(o).e = 359
oring(o).thk = 0.75
fatarc dx, dy, 2, oring(o).rad, 0, 359, floorklr
Next o
End Select
End If
Next
Do
redraw = 0
Do
_Limit 60
kk$ = InKey$
If firstpass = 1 Then
firstpass = 0
redraw = 1
kk$ = "go"
End If
Loop Until kk$ <> ""
Select Case kk$
Case "c" 'copy to clipboard.... this is only supported in windows
_ClipboardImage = dngi&
Case "m", "M"
rrr$ = Str$(tilescale)
getroun$ = _InputBox$("Shape Magnitude", "Enter new magnitude (4) is standard.", rrr$)
tilescale = Int(Val(getroun$))
If tilescale < 1 Then tilescale = 1
Case Else
redraw = 1
End Select
Loop Until redraw = 1
Loop Until kk$ = Chr$(27)
Sub fcirc (CX As Long, CY As Long, R, klr As _Unsigned Long)
'draw a filled circle with the quickest filled circle routine in qb64, not my development
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
Line (CX - X, CY)-(CX + X, CY), klr, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), klr, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), klr, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), klr, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), klr, BF
Wend
End Sub
Sub fatarc (cx, cy, thk, r, sang, eang, klr As _Unsigned Long)
For rangle = sang To eang Step 0.5
ax = cx + r * Cos(0.01745329 * rangle)
ay = cy + r * Sin(0.01745329 * rangle)
fcirc ax, ay, thk, klr
Next rangle
End Sub
Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)
'draw a line with dots with a radial thickness of r from x0,y0 to x1,y1 in color klr
If r > 0.5 Then
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
lineLow x1, y1, x0, y0, r, klr
Else
lineLow x0, y0, x1, y1, r, klr
End If
Else
If y0 > y1 Then
lineHigh x1, y1, x0, y0, r, klr
Else
lineHigh x0, y0, x1, y1, r, klr
End If
End If
Else
Line (x0, y0)-(x1, y1), klr 'line with r of <= 0.5 don't render properly so we force them to be 1 pixel wide on screen
End If
End Sub
Sub lineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
d = (dy + dy) - dx
y = y0
For x = x0 To x1
fcirc x, y, r, klr
If d > 0 Then
y = y + yi
d = d + ((dy - dx) + (dy - dx))
Else
d = d + dy + dy
End If
Next x
End Sub
Sub lineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
D = (dx + dx) - dy
x = x0
For y = y0 To y1
fcirc x, y, r, klr
If D > 0 Then
x = x + xi
D = D + ((dx - dy) + (dx - dy))
Else
D = D + dx + dx
End If
Next y
End Sub
Function inscreen (xx, yy)
'check if point is inside the boreders of the current screen
ii = 1
If xx < 1 Or xx > _Width - 1 Then ii = 0
If yy < 1 Or yy > _Height - 1 Then ii = 0
inscreen = ii
End Function
Sub paintifborder (xx, yy, klr As _Unsigned Long)
If xx = 0 Or xx = _Width Or yy = 0 Or yy = _Height Then
PSet (xx, yy), klr
End If
End Sub
Sub grassfill (x1, y1, x2, y2)
Cls
Line (x1, y1)-(x2, y2), _RGB32(40, 240, 40), BF
For yy = y1 To y2
For xx = x1 To x2 Step 2
bx = Int(Rnd * 2)
Line (xx + bx, yy)-(xx + bx, yy - Int(Rnd * 3)), _RGB32(55 + Int(Rnd * 10), 225 + Int(Rnd * 10), 15 + Int(Rnd * 10))
The wife and I are sitting on the couch after dinner and I have my laptop in front of me working on a program cursing, swearing, and muttering as I go.
She tells me "The working day is over, time for some rest or fun"
I had just realised that I did not thank "the powers that be" for the website banner... "Summer"... So nice to see especially being the middle of winter here in Melbourne.. I do miss the warmth. Thank you for the 'psychological' relief...
A dice parser to return a score from a string that describes a dice roll.
roll("2d6") would return a score from 2 to 12
These routines are part of a Role Playing Game related program and mat be useful to others.
This sample program demonstrates 12 different string and the results generated.
Code: (Select All)
'dice parser july 2023
'by James D. Jarvis
'a simpe dice parser for an RPG game that will evalute a string and generate the roll described
' d = dice,standard equal distribution range
' s = short dice, trends to generate low value in range
' f = fat dice, trends to generate median value in range
' t = tall dice, trend to generate higher values in range
' e = exploding die
'******************************************************
'Include these in nay program using the routines here
'$dynamic
Randomize Timer
Dim Shared de$(0) 'dice experssion
Dim Shared drf$(0) 'dice function
Dim Shared dn
Dim Shared ds
'*******************************************************
Do
For x = 1 To 12
rr = roll(r$(x))
Print r$(x); "= "; rr
Next x
Print
Print "Press any key for more rolls, <esc> to exit"
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
Cls
Loop Until kk$ = Chr$(27)
'roll dice
Function rolld (num, sides)
score = 0
For n = 1 To num
score = score + Int(1 + Rnd * sides)
Next n
rolld = score
End Function
'roll short dice
Function rolls (num, sides)
score = 0
For n = 1 To num
A = Int(1 + Rnd * sides)
B = Int(1 + Rnd * sides)
C = Int(1 + Rnd * sides)
add = A
If add > B Then add = B
If add > C Then add = C
score = score + add
Next n
rolls = score
End Function
'roll tall dice
Function rollt (num, sides)
score = 0
For n = 1 To num
A = Int(1 + Rnd * sides)
B = Int(1 + Rnd * sides)
C = Int(1 + Rnd * sides)
add = A
If B > add Then add = B
If C > add Then add = C
score = score + add
Next n
rollt = score
End Function
'roll fat dice
Function rollf (num, sides)
score = 0
For n = 1 To num * 3
score = score + Int(1 + Rnd * sides)
Next n
rollf = Int(score / 3)
End Function
'roll exploding die
Function rolle (num, sides)
score = 0
b = 0
For n = 1 To num
a = Int(1 + Rnd * sides)
score = score + a
If a = sides Then
Do
b = Int(1 + Rnd * sides)
score = score + b
Loop Until b < sides
End If
Next n
rolle = score
End Function
'break out the individual rolls
Sub find_rolls (idd$)
c = 0
w$ = ""
xc = 0
dd$ = idd$ + "#" 'okay I'm lazy i added a termination symbol to the string
last$ = "+"
Do
c = c + 1
A$ = Mid$(dd$, c, 1)
Select Case A$
Case "+", "-", "/", "*", "#"
xc = xc + 1
ReDim _Preserve de$(xc)
ReDim _Preserve drf$(xc)
de$(xc) = w$
drf$(xc) = last$
w$ = ""
last$ = A$
Case Else
w$ = w$ + A$
End Select
Loop Until c >= Len(dd$)
End Sub
'the main fuction that is called to return a rolled value from the described dice roll
Function roll (idd$)
find_rolls idd$
dn = UBound(de$)
Dim ss(dn)
score = 0
For n = 1 To dn
dit$ = doroll$(de$(n))
Select Case doroll$(de$(n))
Case "d"
ss(n) = rolld(finddn(de$(n), dit$), findds(de$(n), dit$))
Case "s"
ss(n) = rolls(finddn(de$(n), dit$), findds(de$(n), dit$))
Case "t"
ss(n) = rollt(finddn(de$(n), dit$), findds(de$(n), dit$))
Case "f"
ss(n) = rollf(finddn(de$(n), dit$), findds(de$(n), dit$))
Case "e"
ss(n) = rolle(finddn(de$(n), dit$), findds(de$(n), dit$))
Case "V"
ss(n) = Val(de$(n))
End Select
Select Case drf$(n)
Case "+"
score = score + ss(n)
Case "-"
score = score - ss(n)
Case "/" 'divides the previolsy generated score
score = score / ss(n)
Case "*" 'multiplies the previolsy generated score
score = score * ss(n)
End Select
Next n
roll = score
End Function
Function doroll$ (dd$)
c = 1
Dim a$(6)
a$(1) = "d": a$(2) = "s": a$(3) = "f": a$(4) = "t": a$(5) = "e": a$(6) = "V"
d$ = "V"
Do
If InStr(dd$, a$(c)) > 0 Then
d$ = a$(c)
c = 6
End If
c = c + 1
Loop Until c > 6
doroll$ = d$
End Function
Function finddn (dd$, r$)
rp = InStr(dd$, r$)
a = Val(Left$(dd$, rp - 1))
finddn = a
End Function
Function findds (dd$, r$)
rp = InStr(dd$, r$)
a = Val(Right$(dd$, Len(dd$) - rp))
findds = a
End Function