Find attached a file called the set of more dos utilities..
First, this is not QB64. Instead it is QB45/QB71/VBdos..
Next, you get what you see. Some utilities work. Some do not.
There is an imbedded \examples directory with 50 sample files.
Erik.
The packing list is:
Code: (Select All)
More public domain Dos utilities v65.0a packing list:
Runtime files:
Filters: (delete any old TEE*.COM first)..
TEE.EXE -- Piping redirection program
(sends tee stdin to screen/file)
TEE2.EXE -- Piping redirection program
(sends tee stdin to screen/printer/file)
TEE3.EXE -- Piping redirection program
(sends tee stdin to screen/printer/aux/file)
PD Swap Utility:
SHROOM.COM -- Program swapping utility
SHROOM.DOC -- Program documentation
SHROOM.TXT -- Program text info
ASCII.EXE -- Ascii chart maker
BIOS.EXE -- Reads bios list using inline assembly
CLOCK1.EXE -- Display current date\time in window.
COUNT.EXE -- Counts files/lines/bytes of code
DISKCOMP.EXE -- Compares diskettes in drive A:
DISKCOPY.EXE -- Copies diskette from A: to A:
FILECOMP.EXE -- Compares byte values of two files
FINDCODE.EXE -- Program to locate SUB statements
FINDDOC.EXE -- Program to locate keywords
FINDVAR.EXE -- Program to locate variables
FIND.DOC -- Documentation for find utilities
HEXCALC.EXE -- Hex-to-Dec calculator
HEXLIST.EXE -- Hex chart maker
LOWERDTR.EXE -- Modem port utility
MACHINE.EXE -- Local workstation name display utility
RAISEDTR.EXE -- Modem port utility
RUNPROG.EXE -- Starts command line programs
SCRNSAVE.EXE -- Starts Windows screen saver
SERIAL.BAS -- Creates a serial number from date/time
UNINSTAL.EXE -- Generic uninstal utility for DOS
SAMPLE.CFG -- Uninstal config file
WHATIS.EXE -- Expression parser
TROOLEAN.DOC -- Extended boolean charts
Windows utilities:
LIB.EXE -- Library program to create and edit .lib files
MEM.EXE -- Displays various DOS memory settings
NMAKE.EXE -- Compiles programs based on makefile instructions
START.EXE -- Windows utility to launch programs
Misc. files:
AUTHOR.BAT -- Author information program
AUTHOR.TXT -- Author information file
BIOS.TXT -- BIOS equipment list
BREAK.TXT -- Notes on DOS break flag
COHESION.TXT -- Info for utility usage
COMPILE.LST -- Compiler switches list
COMPILE.TXT -- Instructions on compiling
CTRL.TXT -- Short note on Control-Break
DATETIME.TXT -- Further date\time explanations
ERROR.TXT -- List of DOS error codes
EXAMPLE?.BAT -- Examples using utilities
PSPTRICK.TXT -- Text on file handles
SERIAL.TXT -- Info on disk serial number
UPGRADE1.TXT -- Latest upgrade notes
UPGRADE2.TXT -- Old upgrade notes
US.TXT -- U.S. Constitution
VERSION.LST -- Most recent upgrade notes
Misc. list files:
ASCII.TXT -- Text file of ascii codes
ASCII1.TXT -- Ascii codes 0 to 127
ASCII2.TXT -- Ascii codes 128 to 255
HEX.TXT -- Text file of hex codes
HEX1.TXT -- Hex codes 0 to 127
HEX2.TXT -- Hex codes 128 to 255
Misc. readme list files:
README.COM -- Readme program for readme.txt
README.TXT -- Description of utilities
READIT2.COM -- Readme program for disclaim.doc
Misc. utilities:
DOBREAK.BAT -- Example to check DOS break flag state
CHECKBRK.COM -- Returns Errorlevel of break flag
CLEARBRK.COM -- Clears break flag in DOS
COUNTBRK.COM -- Displays actual value of break flag
SETBRK.COM -- Sets break flag in DOS
ZIPCHECK.BAT -- Batch program to check .zip files
BADCHECK.DAT -- Used by Zipcheck.bat
ZIPCHECK.DAT -- Used by Zipcheck.bat
Misc. imbedded file source:
\Examples\*.Zip -- Over 50 examples in BASIC programming.
BC7.INC -- Backward compatible file for BC7 (PDS v7.10) compiling
BC71.INC -- Backward compatible file for BC7 (PDS v7.10) compiling
WHATIS.INC -- Include file for Whatis
ERROR.BAS -- Error function source for VB
ERROR.LIB -- Error function library for VB
ERROR2.BAS -- Error function source for QB
ERROR2.LIB -- Error function library for QB
*.BAS -- Program sources
*.BI -- Source headers
MAKEALL.BAT -- Makes all programs.
LINKALL.BAT -- Links all programs.
MAKEFILE -- Compiler directives for NMAKE.EXE with VB Pro v1.00
MAKEFILE.NMK -- Compiler directives for NMAKE.EXE with VB Pro v1.00
MAKEFILE.BC7 -- Compiler directives for making with BC7 (PDS v7.10)
MAKEZIP.BAT -- Makes Ziplook.exe w/ BC7 (PDS v7.10)
NOEDIT.OBJ -- Line input editing stub file
KEYTRAP.ASM -- Assembly program to trap Control-Break
KEYTRAP.OBJ -- Precompiled source to Keytrap.asm
SWAPBAS.ASM -- Source to Runprog.exe swapper
SWAPBAS.OBJ -- Precompiled Runprog.exe swapper
ZIPVIEW.ASM -- Source to .zip viewing
ZIPVIEW.OBJ -- Precompiled .zip viewing source
Auxiliary files:
*.ASI -- ASIC v5.00 program source
*.BAT -- Batch programs
*.DOC -- Documentation files
*.PRJ -- ASIC v5.00 project files
*.LST -- List files
*.TXT -- Text files
BC.EXE -- The VB Pro v1.00 compiler
LINK.EXE -- Most recent Linker
VBDOS.LIB -- VB Pro v1.00 interrupt assembly library
VBDCL10E.LIB -- VB Pro v1.00 standalone library
VBDRT10E.LIB -- VB Pro v1.00 runtime library
VBDRT10E.EXE -- VB Pro v1.00 runtime module
Required compiling files for Ziplook.exe or for BC7 (PDS v7.10) compiling:
BC.EXE -- The BC v7.10 compiler
LINK.EXE -- Most recent Linker
DTFMTER.LIB -- BC v7.10 date/time format library
QBX.LIB -- BC v7.10 interrupt assembly ibrary
BCL71EFR.LIB -- BC v7.10 standalone library
BCL71ENR.LIB - BC v7.10 standalone library
BRT71EFR.LIB -- BC v7.10 runtime library
BRT71EFR.EXE -- BC v7.10 runtime module
Required compiling files for assembly source:
TASM.EXE -- Turbo assembler 4.0, or any later MASM compilers
Filegate project files:
FILE_ID.DIZ -- Standard distribution text file
These programs and source are hereby placed into the public domain 2014.
The Author respects the Authors of included PD/Shareware programs.
One nice effect is you can have 2 font sizes/styles in the same program. Here is a flow-through example with a large and small lucon font.
Code: (Select All)
$COLOR:32
DIM SHARED overlay, ii
f1 = 22 ' Sets font size to 22 and calculates the max screen height and width for your desktop.
h = (_DESKTOPHEIGHT - 60) \ f1
w = _DESKTOPWIDTH \ (f1 / 1.66)
WIDTH w, h
_SCREENMOVE 0, 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
font& = _LOADFONT(fontpath$, f1 - 2, "monospace") ' - 2 to shorten the screen height just a bit.
_FONT font&
_DELAY .25
swtch = 1
DO
_LIMIT 30
SELECT CASE swtch
CASE 1
CALL prog1
IF INKEY$ = CHR$(27) THEN SYSTEM
CASE -1
CALL prog2
END SELECT
swtch = swtch * -1
LOOP
SUB prog1
ii = ii + 1
IF i > 300 THEN END ' Safety in case of memory leak.
IF ABS(TIMER - z1) > .5 THEN LOCATE 2, 2: PRINT LTRIM$(STR$(ii)); " ";
END SUB
I saw a couple posts on inform recently so I dug this out.
It's one of my first attempts at using qb64 and Inform from several months ago during the before times. It's pretty crude and not remotely amazing but nonetheless semi-functional and shows how I tried to make use of Inform.
DemoZapper
Code: (Select All)
'Demo Zapper
'just fiddling with inform a several months back and whipped this up while still rediscovering QB64
'it's crude, I've gotten a little better witrh qb64 since I did this, but someone may find it useful as a samplen to figure out inform
'one "alien" and one cannon/ship
'
' you are going to need the form (which is posted alogn with this) and you are going to need inform installed to make use of this.
'
'
'
': This program uses
': InForm - GUI library for QB64 - v1.3
': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
': Controls' IDs: ------------------------------------------------------------------
Dim Shared DEMOZAPPER As Long
Dim Shared DEMOZAPPERPX As Long
Dim Shared BT2 As Long
Dim Shared BT As Long
Dim Shared FIREBT As Long
Dim Shared MessageBoxTB As Long
Dim Shared SCORELB As Long
Dim Shared ScoreT As Long
Dim Shared POWERLB As Long
Dim Shared ScoreT2 As Long
Dim Shared HULLLB As Long
Dim Shared ScoreT3 As Long
Dim Shared gamescore As Long
Dim Shared power As Long
Dim Shared hull As Long
Dim Shared shipx As Long
Dim Shared shipY As Long
Dim Shared shipshape$, alienshape$, zapshape$
Dim Shared ax, ay, zx(10), zy(10) As Long
Dim Shared shot, allshots
Dim Shared ASPEED
Dim Shared mess$(5)
mess$(1) = "My Totally lame shooter demo"
mess$(2) = "Take Careful Aim"
mess$(3) = "only one alien for now"
mess$(4) = "Power drain does nothing...yet"
mess$(5) = "Hmmm...."
Randomize Timer
': Event procedures: ---------------------------------------------------------------
Sub __UI_BeforeInit
End Sub
Sub __UI_OnLoad
'here's where I initialize my part of the program.
gamescore = 0
power = 1000
hull = 100
shipx = 256
shipY = 240
shot = 0
allshots = 0
shipshape$ = "R4D8F6D8H6U4L4D4G6U8E6U8"
alienshape$ = "R8F6G3H3G3H3E6"
zapshape$ = "R4D6L4U6"
ax = 30
ay = 30
zx = -1
zy = -1
ASPEED = 1
Caption(MessageBoxTB) = " "
End Sub
Sub __UI_BeforeUpdateDisplay
'This event occurs at approximately 60 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
' this looked like a good spot in what is effectively the main event loop to pur most of the program.
Caption(ScoreT) = Str$(gamescore)
Caption(ScoreT2) = Str$(power)
Caption(ScoreT3) = Str$(hull)
mm = Int(Rnd * 500) + 1
If mm < 6 Then Caption(MessageBoxTB) = mess$(mm)
'drawship
_Dest Control(Canvas).HelperCanvas
k = _RGB(111, 200, 200)
BeginDraw DEMOZAPPERPX
Cls , _RGB32(0, 0, 50)
PSet (shipx, shipY), k
Draw shipshape$
If ax > 0 Then
PSet (ax, ay), k
Draw alienshape$
End If
If shot > 0 Then
For z = 1 To shot
If zx(z) > 0 Then
k = _RGB(200, 20, 20)
PSet (zx(z), zy(z)), k
Draw zapshape$
If Int(zx(z) / 8) = Int((ax + 2.5) / 8) And Int(zy(z) / 8) = Int(ay / 8) Then
Beep
ax = -1
ay = -1
gamescore = gamescore + 100
zx(z) = -1
zy(z) = -1
End If
End If
Next z
End If
EndDraw DEMOZAPPERPX
'move game elements
If ax < 500 Then
ax = ax + ASPEED
Else
ax = -10
ay = Int(Rnd * 20) + 20
End If
If shot > 0 Then
For z = 1 To shot
If zy(z) > 0 Then
zy(z) = zy(z) - 4
Else
zx(z) = -1
zy(z) = -1
End If
Next z
If zy(shot) = -1 And shot = 10 Then shot = 0
End If
End Sub
Sub __UI_BeforeUnload
'If you set __UI_UnloadSignal = False here you can
'cancel the user's request to close.
End Sub
Sub __UI_Click (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
shipx = shipx - 4
Case BT
shipx = shipx + 4
Case FIREBT
'if the fire button is pressed do this!
If power > 0 And shot < 10 Then
shot = shot + 1
zx(shot) = shipx
zy(shot) = shipY - 8
power = power - 1
End If
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_MouseEnter (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_MouseLeave (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_FocusIn (id As Long)
Select Case id
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
End Select
End Sub
Sub __UI_FocusOut (id As Long)
'This event occurs right before a control loses focus.
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
Select Case id
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
End Select
End Sub
Sub __UI_MouseDown (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
'go that way
shipx = shipx - 1
Case BT
'go this way
shipx = shipx + 1
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_MouseUp (id As Long)
Select Case id
Case DEMOZAPPER
Case DEMOZAPPERPX
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
Case SCORELB
Case ScoreT
Case POWERLB
Case ScoreT2
Case HULLLB
Case ScoreT3
End Select
End Sub
Sub __UI_KeyPress (id As Long)
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
'You can change it and even cancel it by making it = 0
Select Case id
Case BT2
Case BT
Case FIREBT
Case MessageBoxTB
End Select
End Sub
Sub __UI_TextChanged (id As Long)
Select Case id
Case MessageBoxTB
End Select
End Sub
Sub __UI_ValueChanged (id As Long)
Select Case id
End Select
End Sub
Sub __UI_FormResized
End Sub
'$INCLUDE:'InForm\InForm.ui'
and the form so that works.
Code: (Select All)
': This form was generated by
': InForm - GUI library for QB64 - v1.3
': Fellippe Heitor, 2016-2021 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------
Sub __UI_LoadForm
Dim __UI_NewID As Long, __UI_RegisterResult As Long
Even though they've had FLAC in QB64pe for a while I'm just now getting into it. Which is weird because I love FLAC files. The majority of my music library is FLAC format because I'm a big audiophile. Anyways, I decided to look into the FLAC format for tags and such as well as the embedded album art stuff. Turns out, super easy to grab data from a FLAC file. Here's the test code I've used:
Code: (Select All)
Option Explicit
$NoPrefix
$Console
Dim As String file: file = "07 - Project 86 - Team Black.flac"
Dim As Long hfile: hfile = FreeFile
Open "B", hfile, file
Dim As String rawdata: rawdata = Space$(LOF(hfile))
Get hfile, , rawdata
Close
Dim As String SOI: SOI = Chr$(&HFF) + Chr$(&HD8)
Dim As String EOI: EOI = Chr$(&HFF) + Chr$(&HD9)
Dim As String lyrics: lyrics = Mid$(rawdata, InStr(rawdata, "LYRICS=") + Len("LYRICS=")): lyrics = Mid$(lyrics, 1, InStr(lyrics, Chr$(0)) - 2)
Dim As Long tracknumber: Dim As String track: track = Mid$(rawdata, InStr(rawdata, "TRACKNUMBER=") + Len("TRACKNUMBER=")): track = Mid$(track, 1, InStr(track, Chr$(0))): tracknumber = Val(track)
Dim As String songtitle: songtitle = Mid$(rawdata, InStr(rawdata, "TITLE=") + Len("TITLE=")): songtitle = Mid$(songtitle, 1, InStr(songtitle, Chr$(0)) - 2)
Dim As String albumtitle: albumtitle = Mid$(rawdata, InStr(rawdata, "ALBUM=") + Len("ALBUM=")): albumtitle = Mid$(albumtitle, 1, InStr(albumtitle, Chr$(0)) - 2)
Dim As String artist: artist = Mid$(rawdata, InStr(rawdata, "ARTIST=") + Len("ARTIST=")): artist = Mid$(artist, 1, InStr(artist, Chr$(0)) - 2)
Dim As String albumdate: albumdate = Mid$(rawdata, InStr(rawdata, "DATE=") + Len("DATE=")): albumdate = Mid$(albumdate, 1, InStr(albumdate, Chr$(6)) - 1)
Dim As String image: image = Mid$(rawdata, InStr(rawdata, SOI)): image = Mid$(image, 1, InStr(image, EOI) + Len(EOI))
If Len(image) > 0 Then
Dim As Long hpic: hpic = FreeFile
If FileExists("cover.jpg") Then Kill "cover.jpg"
Open "B", hpic, "cover.jpg"
Put hpic, , image
Close
Dim As Long i: i = LoadImage("cover.jpg", 32)
If i < -1 Then Screen i Else Beep
rawdata = ""
Echo lyrics
Print "Artist:", artist
Print "Album :", albumtitle
Print "Track :", tracknumber
Print "Title :", songtitle
Print "Date :", albumdate
Title artist + " - " + songtitle
ConsoleTitle Title$ + " lyrics"
Dim As Long snd: snd = SndOpen(file, "stream")
If snd Then SndPlay snd
End If
And a test video:
I hope to make me a new project with the code. Obviously a point-and-click GUI. Probably Win32. I will have a trackbar for changing song position as well as a popup window for the lyrics and such. If I get really ambitious then I'll see about making me a tag editor for FLAC/MP3/WAV/etc files.
To download the song for testing: Project 86 - Team Black
So, I have a massive data base of decimal value with 5 digits after the decimal. I have routine which is trying to find the highest and the lowest of these values. Here is the algorythm that I am using but for some reason it's giving me the Highest value as the Lowest and the Lowest as the Highest.
HL = DataBaseValue
If HL < 1 And HL < Low Then Low = HL
Low = (_Round(Low * 100000)) / 100000
If HL < 1 And HL > High Then High = HL
High = (_Round(High * 100000)) / 100000
The rounding is to avoid scientific notation and be sure result will be 5 digit decimal value.
I can't see why this algorythm would give the High as Low and the Low as High.
I am making a space shooter game, and my idea is to make it online for playing with friends... but I have a very big problem, I don't know how to communicate one pc to another
I changed the line "TCP/IP:1234:localhost" and tried everything... my last one was "TCP/IP:8080:xxx.yyy.zzz.nnn" (where xxx.yyy.zzz.nnn is my current IP), but it is useless.
Any ideas?
Both PCs are NOT in the same LAN, one is mine and the other is from a work colleague.
Inform now no longer works with QB64pe. I found the website that suppose to have the fix for it, but I am unable to download it. Seems there is some java script involved that my browser refuses to allow. Is there any way I can get that script so I can fix Inform so it will work?
A method to draw lines of variable thickness making use of rotozoom2
has routines to draw a line of any pixel thickness, outlined polygons, and filled polygons with a few different fill methods.,
I've made heavy use of B+'s code to get this working.
Code: (Select All)
_Title "Drawing with lines of variable thickness"
'by James D. Jarvis adapted using code by B+
' this uses RotoZoom2 to draw a line of any thickness.
'
Randomize Timer
Const xmax = 800
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)
Function Rtan2 (x1, y1, x2, y2)
'get the angle (in radians) from x1,y1 to x2,y2
deltaX = x2 - x1
deltaY = y2 - y1
rtn = _Atan2(deltaY, deltaX)
If rtn < 0 Then Rtan2 = rtn + (2 * _Pi) Else Rtan2 = rtn
End Function
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
rsqrd = r * r
y = -r
While y <= r
x = Sqr(rsqrd - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
y = y + 1
Wend
End Sub
'====================================================================
' draw a line of color klr and thickness thk
'====================================================================
Sub dline (x1, y1, x2, y2, klr As _Unsigned Long, thk)
storeDest& = _Dest
hyp = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) 'detrmine the length of the line
yy = 1 * thk
xx = Int(hyp + .9)
II& = _NewImage(xx, Int(yy + .5), 32)
_Dest II&
Line (0, 0)-(xx, yy), klr, BF 'draw the line in the temporary image buffer
centerx = (x1 + x2) / 2
centery = (y1 + y2) / 2
_Dest storeDest&
rotation = Rtan2(x1, y1, x2, y2) 'find the angle of the line in radians as rotozoom2 uses radians
RotoZoom2 centerx, centery, II&, 1, 1, rotation 'copy the line to it's position on the screen using rotozoom2
_FreeImage II&
End Sub
'This sub gives really nice control over displaying an Image.
Sub RotoZoom2 (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
Dim px(3) As Single: Dim py(3) As Single
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
'====================================================================
' rotopoly2 draws a polygon wit variable line thickness
'====================================================================
Sub rotopoly2 (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long, thk)
x = 0
y = 0
For deg = turn To turn + 360 Step shapedeg
x2 = rr * Cos(0.01745329 * deg)
y2 = rr * Sin(0.01745329 * deg)
'If x <> 0 Then Line (cx + x, cy + y)-(cx + x2, cy + y2), klr
If x <> 0 Then dline cx + x, cy + y, cx + x2, cy + y2, klr, thk
x = x2
y = y2
circleBF (cx + x2), (cy + y2), (thk) \ 2, klr 'fills in the open gap at polygon line intersections
Next
End Sub
'====================================================================
' triploy draw a filled polygon by rendereing multiple triangles of the same color
'====================================================================
Sub tripoly (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long)
storeDest& = _Dest
I& = _NewImage(3, 3, 32)
_Dest I&
Line (0, 0)-(_Width, _Height), klr, BF
x = 0
y = 0
_Dest storeDest&
For deg = turn To turn + 360 Step shapedeg
x2 = rr * Cos(0.01745329 * deg)
y2 = rr * Sin(0.01745329 * deg)
If x <> 0 Then _MapTriangle (0, 0)-(0, 2)-(2, 2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
x = x2
y = y2
Next
_FreeImage I&
End Sub
'====================================================================
'fillpoly creates filled polygons
'a temporary image is created and trignels for each segment of that tmeporary image are copied to the screen
'currently 7 modes are defined
'CF- color fill, HH - horizontal line fill, VV- vertical line fill
'AF - alternating segment color fill, AH & AV are alternationg horizonatl or vetical
'noise- creaes a fill of randomly colore points
'======================================================================
Sub fillpoly (cx, cy, rr, shapedeg, turn, klr1 As _Unsigned Long, klr2 As _Unsigned Long, thk, mode$)
storeDest& = _Dest
siz = (rr * Cos(0.01745329 * deg)) * 2
sx = siz / 2: sy = siz / 2
I& = _NewImage(siz, siz, 32)
_Dest I&
Select Case UCase$(mode$)
Case "CF", "AF"
Line (0, 0)-(siz, siz), klr2, BF
Case "HH", "AH"
For y = 0 To siz Step thk
Line (0, y)-(siz, y - 1 + thk / 2), klr2, BF
Next
Case "VV", "AV"
For x = 0 To siz Step thk
Line (x, 0)-(x - 1 + thk / 2, siz), klr2, BF
Next
Case "NOISE"
For y = 0 To siz
For x = 0 To siz
PSet (x, y), _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)
Next x
Next y
End Select
x = 0
y = 0
_Dest storeDest&
sc = 0
For deg = turn To turn + 360 Step shapedeg
sc = sc + 1
x2 = rr * Cos(0.01745329 * deg)
y2 = rr * Sin(0.01745329 * deg)
If x <> 0 Then
Select Case UCase$(mode$)
Case "AF", "AH", "AV"
If (sc Mod 2) <> 0 Then _MapTriangle (sx, sy)-(sx + x, sy + y)-(sx + x2, sy + y2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
Case Else
_MapTriangle (sx, sy)-(sx + x, sy + y)-(sx + x2, sy + y2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
End Select
End If
x = x2
y = y2
Next
_FreeImage I&
If klr1 <> 0 Then rotopoly2 cx, cy, rr, shapedeg, turn, klr1, thk
End Sub
This example will not write to your drive. It is a high score hardware overlay, but I stripped out the file stuff.
The overlay is called repeatedly to mimic a flashing cursor. See CALL underline() sub.
What I find is the repeated call keeps copying a new image, one with the cursor showing, and one hidden. That's just 2 images, but since it keeps getting called, instead of switching images (I don;t no how of if that's possible) it just keeps making more of the same alternating screen copy images, which keeps multiplying the memory usage until other OS systems are affected.
You can monitor what I'm talking about by running Windows Task Manager with this code.
Now according to the wiki, I can't use _FREEIMAGE in the loop because I'm not changing screens. I do use it after the original screen is reactivated.
So is there a way to accomplish this flashing cursor effect in the hardware image without burning up the system's memory?
Code: (Select All)
$COLOR:32
REM Main
f1 = 22 ' Sets font size to 22 and calculates the max screen height and width for your desktop.
h = (_DESKTOPHEIGHT - 60) \ f1
w = _DESKTOPWIDTH \ (f1 / 1.66)
WIDTH w, h
_SCREENMOVE 0, 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
font& = _LOADFONT(fontpath$, f1, "monospace")
_FONT font&
_DELAY .25
_RESIZE ON , _SMOOTH ' Allows resizing. Note: this is for slight adjustments. As of this version there is no compensatory function to change the font size during screen size changes.
DIM SHARED Overlay, g.population
g.population = 100000
lscr = hardware_left + 6
z3 = TIMER
WHILE -1
initials$ = "": i = 0: nxt = 0
COLOR , _RGB(24, 24, 24): t$ = " " ' Blank initials for redo. Okay to blank at start.
PSL hardware_top + 2 + rank * 2, lscr, t$
_DISPLAY
DO
_LIMIT 30
IF ABS(z3 - TIMER) > .3 THEN ' Flashing cursor
underline hardware_top + 2 + rank * 2, lscr + nxt, 0
_DISPLAY
z3 = TIMER
END IF
ky$ = UCASE$(INKEY$)
IF LEN(ky$) THEN
IF ky$ = CHR$(13) THEN
kflag = 3
ELSEIF ky$ = CHR$(8) AND LEN(initials$) THEN
kflag = 2
ELSEIF ky$ = CHR$(27) THEN
kflag = 4
ELSEIF ky$ >= "A" AND ky$ <= "Z" AND LEN(initials$) < 3 THEN
initials$ = initials$ + ky$
kflag = 1
ELSE
ky$ = "": kflag = 0
END IF
END IF
MID$(hsdata$(rank), 5, 3) = hsname$ + SPACE$(3 - LEN(hsname$))
OPEN "ascii-invaders-high-score.dat" FOR RANDOM AS #1 LEN = 25
FOR i = 1 TO 5
hs = hsdata$(i)
IF LEFT$(hs, 1) = "" THEN MID$(hs, 1, 2) = "0" + LTRIM$(STR$(i))
PUT #1, i, hs
NEXT
CLOSE #1
EXIT WHILE
WEND
bxy% = hardware_top + 1
COLOR Black, Yellow
t$ = " NAME SCORE DATE "
PSL bxy% + 1, bxx% + 1, t$
COLOR Yellow, 0
FOR i = 1 TO 5
t$ = hsdata$(i)
PSL bxy% + 1 + i * 2, bxx% + 2, t$
NEXT
_DISPLAY
RETURN
hiscore:
FOR i = 1 TO 5
IF VAL(score$) > VAL(highscore$(i)) THEN rank = i: EXIT FOR
NEXT
hsdata$(6) = SPACE$(25)
MID$(hsdata$(6), 10, 6) = score$
MID$(hsdata$(6), 18, 8) = MID$(DATE$, 1, 6) + MID$(DATE$, 9, 2)
highscore$(6) = score$
FOR i = 1 TO 6
FOR j = 1 TO 6
IF i <> j THEN
IF VAL(highscore$(i)) > VAL(highscore$(j)) THEN
SWAP highscore$(i), highscore$(j)
SWAP hsdata$(i), hsdata$(j)
END IF
END IF
NEXT
NEXT
FOR i = 1 TO 5
MID$(hsdata$(i), 1, 2) = "0" + LTRIM$(STR$(i))
NEXT
RETURN
END SUB
SUB PSLC (y!, x, t$)
_PRINTSTRING ((x - 1) * 8, (y! - 1) * 16), t$
END SUB
SUB PSL (y!, x, t$)
_PRINTSTRING ((x - 1) * _FONTWIDTH, (y! - 1) * _FONTHEIGHT), t$
Overlay_Hardware = _COPYIMAGE(Overlay, 33)
_PUTIMAGE (0, 0), Overlay_Hardware
END SUB
SUB underline (y, x, uflag)
STATIC ucnt
ucnt = -ucnt - 1
IF ucnt OR uflag THEN
LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), _RGB(24, 24, 24), BF
ELSE
LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), Yellow, BF
END IF
Overlay_Hardware = _COPYIMAGE(Overlay, 33)
_PUTIMAGE (0, 0), Overlay_Hardware
END SUB
