| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
As technology rapidly evo...
Forum: Utilities
Last Post: Frankvab
06-15-2025, 06:09 AM
» Replies: 14
» Views: 165
|
Everybody's heard about t...
Forum: Utilities
Last Post: Frankvab
06-15-2025, 06:07 AM
» Replies: 22
» Views: 1,366
|
MBA Assignment Help in Du...
Forum: General Discussion
Last Post: hafsahomar
06-11-2025, 07:05 AM
» Replies: 0
» Views: 22
|
лучшие песни медляки слуш...
Forum: Petr
Last Post: WillieTop
06-08-2025, 02:21 AM
» Replies: 0
» Views: 30
|
пинк слушать онлайн беспл...
Forum: SMcNeill
Last Post: WillieTop
06-08-2025, 02:20 AM
» Replies: 0
» Views: 24
|
скачать музыку российскую...
Forum: madscijr
Last Post: WillieTop
06-08-2025, 02:18 AM
» Replies: 0
» Views: 25
|
нежная музыка mp3 скачать
Forum: Keybone
Last Post: WillieTop
06-08-2025, 02:17 AM
» Replies: 0
» Views: 26
|
лучшая песня слушать онла...
Forum: bplus
Last Post: WillieTop
06-08-2025, 02:16 AM
» Replies: 0
» Views: 30
|
пикник слушать онлайн луч...
Forum: Spriggsy
Last Post: WillieTop
06-08-2025, 02:15 AM
» Replies: 0
» Views: 25
|
какая сейчас популярная м...
Forum: RhoSigma
Last Post: WillieTop
06-08-2025, 02:14 AM
» Replies: 0
» Views: 20
|
|
|
| DOW - Happy Birthday, Merry Christmas, When? |
|
Posted by: TarotRedhand - 05-22-2022, 05:14 PM - Forum: Programs
- Replies (5)
|
 |
Just a small program for finding out what day of the week an event occurred/will occur on. Choose from Birthday, Western Christmas Day or any random day you choose. Unlike the other stuff I've posted on here to date, this is a fresh build. It Uses a tiny (edited) portion of the Time utility I posted recently. FWIW error trapping the INPUTs was a pain.
WhatDay.BAS
Code: (Select All) Const TRUE% = -1
Const FALSE% = 0
Dim Choice$, AYear%, AMonth%, ADay%, DayNumber%, OutString$, YearPrompt$
Print
Print "What date do you want to know the day of the week for?"
Print "Your Birthday, Western Christmas Day or some other date?"
Print "The year chosen must be be between 1900 and 2099 inclusive."
Print
Print "Choose 'B', 'C' or 'O'"
Print
Do
Choice$ = UCase$(InKey$)
Loop Until ((Choice$ = "B") Or (Choice$ = "C") Or (Choice$ = "O"))
Print
Print
If Choice$ = "C" Then
YearPrompt$ = "Which Year's Christmas are you interested in? (In #### format) -> "
Do
Print YearPrompt$;
Input AYear%
If ((AYear% < 1900) Or (AYear% > 2099)) Then
Print
Print "Sorry, but that year is outside the scope of this program."
Print
End If
Loop Until ((AYear% >= 1900) And (AYear% <= 2099))
DayNumber% = DayOfWeek%(AYear%, 12, 25)
OutString$ = "In " + LTrim$(Str$(AYear%)) + " Christmas Day fell/will fall on a "
Print
Print
Else
If Choice$ = "B" Then
YearPrompt$ = "Which Year's Birthday are you interested in? (In #### format) -> "
Else
YearPrompt$ = "Which particular Year's Date are you interested in? (In #### format) -> "
End If
Do
Print YearPrompt$;
Input AYear%
If ((AYear% < 1900) Or (AYear% > 2099)) Then
Print
Print "Sorry, but that year is outside the scope of this program."
Print
End If
Loop Until ((AYear% >= 1900) And (AYear% <= 2099))
Do
Input "And the Month Number? (1 to 12) ", AMonth%
If ((AMonth% < 1) Or (AMonth% > 12)) Then
Print
Print "Sorry, but that Month does not exist."
Print
End If
Loop Until ((AMonth% > 0) And (AMonth% < 13))
Do
Do
Input "And finally the Day Number? (1 to 31) ", ADay%
If ((ADay% < 1) Or (ADay% > 31)) Then
Print
Print "Sorry, but that Day does not exist."
Print
End If
Loop Until ((ADay% >= 1) And (ADay% <= 31))
Loop Until (DayMonthMatch%(AYear%, AMonth%, ADay%) = TRUE%)
DayNumber% = DayOfWeek%(AYear%, AMonth%, ADay%)
Print
Print
If Choice$ = "B" Then
OutString$ = "In " + LTrim$(Str$(AYear%)) + " Your Birthday fell/will fall on a "
Else
OutString$ = "The " + LTrim$(Str$(ADay%)) + Suffix$(ADay%) + " of " + StringMonth$(AMonth%) + " in " + LTrim$(Str$(AYear%)) + ", is/was on a "
End If
End If
Print OutString$ + StringWeekDay$(DayNumber%) + "."
End
Function DayMonthMatch% (Year%, Month%, Day%)
Dim IsValid%
Select Case Month%
Case 1, 3, 5, 7, 8, 10, 12
IsValid% = TRUE%
Case 2
If ((((Year% Mod 400) = 0) And (Day% > 29)) Or (((Year% Mod 4) = 0) And ((Year% Mod 100) <> 0) And (Day% > 29))) Then
IsValid% = FALSE%
ElseIf Day% > 28 Then
IsValid% = FALSE%
Else
IsValid% = TRUE%
End If
Case 4, 6, 9, 11
If Day% > 30 Then
IsValid% = FALSE%
Else
IsValid% = TRUE%
End If
End Select
DayMonthMatch% = IsValid%
End Function
Function DayOfWeek% (Year%, Month%, Day%)
Dim Year$, Code%
Year$ = Str$(Year%)
Code% = Val(Right$(Year$, 2))
Code% = (Code% + (Code% \ 4)) Mod 7
Code% = Code% + Val(Mid$("033614625035", Month%, 1))
If (Year% >= 2000) Then
Code% = Code% + 6
End If
If (((Year% Mod 400) = 0) And (Month% > 2)) Then
Code% = Code% + 1
ElseIf (((Year% Mod 4) = 0) And ((Year% Mod 100) <> 0) And (Month% > 2)) Then
Code% = Code% + 1
End If
Code% = Code% + Day%
DayOfWeek% = 1 + (Code% Mod 7)
End Function
Function StringWeekDay$ (DayCode%)
Dim DayString$
Select Case DayCode%
Case 1
DayString$ = "Sunday"
Case 2
DayString$ = "Monday"
Case 3
DayString$ = "Tuesday"
Case 4
DayString$ = "Wednesday"
Case 5
DayString$ = "Thursday"
Case 6
DayString$ = "Friday"
Case 7
DayString$ = "Saturday"
End Select
StringWeekDay$ = DayString$
End Function
Function StringMonth$ (MonthCode%)
Dim MonthString$
Select Case MonthCode%
Case 1
MonthString$ = "January"
Case 2
MonthString$ = "February"
Case 3
MonthString$ = "March"
Case 4
MonthString$ = "April"
Case 5
MonthString$ = "May"
Case 6
MonthString$ = "June"
Case 7
MonthString$ = "July"
Case 8
MonthString$ = "August"
Case 9
MonthString$ = "September"
Case 10
MonthString$ = "October"
Case 11
MonthString$ = "November"
Case 12
MonthString$ = "December"
End Select
StringMonth$ = MonthString$
End Function
Function Suffix$ (MonthDay%)
Dim TempString$
If ((MonthDay% > 3) And (MonthDay% < 21)) Then
TempString$ = "th"
Else
TempMonthDay% = MonthDay% Mod 10
Select Case TempMonthDay%
Case 0
TempString$ = "th"
Case 1
TempString$ = "st"
Case 2
TempString$ = "nd"
Case 3
TempString$ = "rd"
Case Else
TempString$ = "th"
End Select
End If
Suffix$ = TempString$
End Function
Have fun.
TR
|
|
|
| Image fitment sub |
|
Posted by: OldMoses - 05-22-2022, 04:01 PM - Forum: Utilities
- No Replies
|
 |
Here's a rehash of a little SUB I use when I have unpredictable sized, or aspect ratio'ed images to place in a predefined area. I call it Image_Resize. With the parameters, set a window area, identify source and destination, then set justifications (up, down, left, right, center). It does all the _PUTIMAGE figuring and then puts it, sized for best fit to the area.
A rehash because I originally posted it in the old forum, but I spruced up the example/demo code. Adding an image nesting and a swelling routine. The SUB itself has some of that cryptic looking branchless code, which was able to remove around 16 lines of SELECT CASE stuff, but I'm insufferably proud of that and haven't been able to break it yet. 
While it doesn't do rotations, there's always Rotozoom'ing to a temporary handle for that and I saw no reason to try and reinvent that wheel.
Code: (Select All) 'Size and justify an image to fit in a predefined space using branchless equations. by OldMoses
_TITLE "Image Sizing demo #2"
SCREEN _NEWIMAGE(1024, 512, 32)
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 5, 5
lim& = &H01011111 ' phantom line style
c~& = &H7FFFFFFF ' phantom line color
_PRINTMODE _KEEPBACKGROUND
'create test patterns, one wider & one taller (comment out if using your own images)
W& = _NEWIMAGE(750, 480, 32)
_DEST W&
COLOR , &HFFFF0000
CLS
FOR x = 100 TO 90 STEP -1
CIRCLE (150, 240), x, &HFF0000FF
CIRCLE (375, 240), x, &HFF0000FF
CIRCLE (600, 240), x, &HFF0000FF
NEXT x
T& = _NEWIMAGE(480, 750, 32)
_DEST T&
COLOR , &HFF008000
CLS
FOR x = 1 TO 10
LINE (100 + x, 100 + x)-(380 - x, 380 - x), &HFFFF0000, B
LINE (100 + x, 470 + x)-(380 - x, 650 - x), &HFFFF0000, B
NEXT x
_PRINTSTRING (120, 120), "||||||||"
_PRINTSTRING (120, 490), "________"
'Or load images of your choosing in lieu of test patterns, and comment out the above patterns
'W& = _LOADIMAGE("", 32)
'T& = _LOADIMAGE("", 32)
_DEST 0
CLS
x% = 400: y% = 20: x1% = 650: y1% = 300 ' use predetermined part of the screen (400, 20)-(650, 300)
LINE (x%, y%)-(x1%, y1%), c~&, B , lim& ' show target area
Image_Resize x%, y%, x1%, y1%, W&, 0, "c", "u" ' justify up, wide image
_PRINTSTRING (0, 512 - 32), "area=(400, 20)-(650, 300) wide image, top justified (any key to continue)"
_PRINTSTRING (0, 512 - 16), "Syntax: Image_Resize 400, 20, 650, 300, W&, 0, " + CHR$(34) + "c" + CHR$(34) + ", " + CHR$(34) + "u" + CHR$(34)
SLEEP
CLS
LINE (x%, y%)-(x1%, y1%), c~&, B , lim& ' show target area
Image_Resize x%, y%, x1%, y1%, T&, 0, "r", "c" ' justify right, tall image
_PRINTSTRING (0, 512 - 32), "area=(400, 20)-(650, 300) tall image, right justified (any key to continue)"
_PRINTSTRING (0, 512 - 16), "Syntax: Image_Resize 400, 20, 650, 300, T&, 0, " + CHR$(34) + "r" + CHR$(34) + ", " + CHR$(34) + "c" + CHR$(34)
SLEEP
CLS
x% = 0: y% = 0: x1% = _WIDTH - 1: y1% = _HEIGHT - 1 ' use full screen
Image_Resize x%, y%, x1%, y1%, W&, 0, "c", "u" ' justify up, wide image
_PRINTSTRING (0, 512 - 32), "area=full screen, wide image, top justified (any key to continue)"
_PRINTSTRING (0, 512 - 16), "Syntax: Image_Resize 0, 0, _WIDTH - 1, _HEIGHT - 1, W&, 0, " + CHR$(34) + "c" + CHR$(34) + ", " + CHR$(34) + "u" + CHR$(34)
SLEEP
CLS
Image_Resize x%, y%, x1%, y1%, T&, 0, "l", "c" ' justify left, tall image
_PRINTSTRING (400, 512 - 32), "area=full screen, tall image, left justified (any key to continue)"
_PRINTSTRING (400, 512 - 16), "Syntax: Image_Resize 0, 0, _WIDTH - 1, _HEIGHT - 1, T&, 0, " + CHR$(34) + "l" + CHR$(34) + ", " + CHR$(34) + "c" + CHR$(34)
SLEEP
CLS
Image_Resize x%, y%, x1%, y1%, W&, 0, "c", "d" ' justify down, wide image
_PRINTSTRING (0, 512 - 32), "area=full screen, wide image, bottom justified (any key to continue)"
_PRINTSTRING (0, 512 - 16), "Syntax: Image_Resize 0, 0, _WIDTH - 1, _HEIGHT - 1, W&, 0, " + CHR$(34) + "c" + CHR$(34) + ", " + CHR$(34) + "d" + CHR$(34)
SLEEP
CLS
x% = 25: y% = 450: x1% = 250: y1% = 512 ' use predetermined part of the screen (25, 450)-(250, 580)
LINE (x%, y%)-(x1%, y1%), c~&, B , lim& ' show target area
Image_Resize x%, y%, x1%, y1%, W&, 0, "c", "c" ' justify center, wide image
_PRINTSTRING (0, 0), "area=(25, 450)-(250, 512) wide image, center justified (any key to continue)"
_PRINTSTRING (0, 16), "Syntax: Image_Resize 25, 450, 250, 512, W&, 0, " + CHR$(34) + "c" + CHR$(34) + ", " + CHR$(34) + "c" + CHR$(34)
SLEEP
CLS
LINE (x%, y%)-(x1%, y1%), c~&, B , lim& ' show target area
Image_Resize x%, y%, x1%, y1%, T&, 0, "c", "c" ' justify center, tall image
_PRINTSTRING (0, 0), "area=(25, 450)-(250, 512) tall image, center justified (any key to continue)"
_PRINTSTRING (0, 16), "Syntax: Image_Resize 25, 450, 250, 512, T&, 0, " + CHR$(34) + "c" + CHR$(34) + ", " + CHR$(34) + "c" + CHR$(34)
SLEEP
'nesting sub images in others
CLS
tmp& = _COPYIMAGE(T&)
_DEST tmp&
LINE (_SHR(_WIDTH(tmp&), 1), 0)-(_WIDTH(tmp&) - 1, _SHR(_HEIGHT(tmp&), 1)), c~&, B , lim&
Image_Resize _SHR(_WIDTH(tmp&), 1), 0, _WIDTH(tmp&) - 1, _SHR(_HEIGHT(tmp&), 1), W&, tmp&, "c", "c"
_DEST 0
Image_Resize 0, 0, 1024, 512, tmp&, 0, "r", "c"
_FREEIMAGE tmp&
_PRINTSTRING (0, 0), "area=full screen, wide image IN tall image, right justified (any key to continue)"
_PRINTSTRING (0, 16), "Example code:"
_PRINTSTRING (0, 32), "tmp& = _COPYIMAGE(T&)"
_PRINTSTRING (0, 48), "_DEST tmp&"
_PRINTSTRING (0, 64), "Image_Resize _SHR(_WIDTH(tmp&), 1), 0, _WIDTH(tmp&) - 1, _SHR(_HEIGHT(tmp&), 1), W&, tmp&, " + CHR$(34) + "c" + CHR$(34) + ", " + CHR$(34) + "c" + CHR$(34)
_PRINTSTRING (0, 80), "_DEST 0"
_PRINTSTRING (0, 96), "Image_Resize 0, 0, 1024, 512, tmp&, 0, " + CHR$(34) + "r" + CHR$(34) + ", " + CHR$(34) + "c" + CHR$(34)
_PRINTSTRING (0, 112), "_FREEIMAGE tmp&"
SLEEP
'expanding and moving an image around the screen
FOR swell% = 0 TO 256
CLS
Image_Resize swell%, swell%, swell% * 2, swell% * 2, W&, 0, "c", "u"
_LIMIT 100
_DISPLAY
NEXT swell%
_PRINTSTRING (0, 0), "Example code:"
_PRINTSTRING (0, 16), "FOR swell% = 0 TO 256"
_PRINTSTRING (0, 32), " CLS"
_PRINTSTRING (0, 48), " Image_Resize swell%, swell%, swell% * 2, swell% * 2, W&, 0, " + CHR$(34) + "c" + CHR$(34) + ", " + CHR$(34) + "u" + CHR$(34)
_PRINTSTRING (0, 64), " _LIMIT 100"
_PRINTSTRING (0, 80), " _DISPLAY"
_PRINTSTRING (0, 96), "NEXT swell%"
'and you get the idea...
END
SUB Image_Resize (xpos AS INTEGER, ypos AS INTEGER, xlim AS INTEGER, ylim AS INTEGER, i AS LONG, d AS LONG, xj AS STRING, yj AS STRING)
'Syntax: upper left x, upper left y, lower right x, lower right y, image handle, destination handle, horizontal justification, vertical justification
'horizontal justifications= "l" left, "c" center, "r" right
'vertical justifications= "u" up, "c" center, "d" down
DIM AS INTEGER xs, ys, xp, yp, xl, yl
DIM AS SINGLE rt, xrt, yrt
xrt = (xlim - xpos) / _WIDTH(i) ' width of area divided by width of image
yrt = (ylim - ypos) / _HEIGHT(i) ' height of area divided by height of image
rt = -xrt * (xrt < yrt) - yrt * (yrt <= xrt) ' pick the smaller of the two ratios to fit area
xs = _WIDTH(i) * rt ' final image size ratio in x
ys = _HEIGHT(i) * rt ' final image size ratio in y
xp = -xpos * (xj = "l") - (_SHR(xlim - xpos, 1) + xpos - _SHR(xs, 1)) * (xj = "c") - (xlim - xs) * (xj = "r")
xl = xp + xs
yp = -ypos * (yj = "u") - (_SHR(ylim - ypos, 1) + ypos - _SHR(ys, 1)) * (yj = "c") - (ylim - ys) * (yj = "d")
yl = yp + ys
_PUTIMAGE (xp, yp)-(xl, yl), i, d
END SUB 'Image_Resize
|
|
|
|
| MemWave - Play WAV audio from string memory using Win API |
|
Posted by: Dav - 05-22-2022, 02:07 PM - Forum: Dav
- Replies (1)
|
 |
MemWave uses a Windows API call to play a WAV file loaded as a string. This way you can include small sounds directly in BAS code and play them from string memory, not from an external file. The example code posted will play a howling WAV sound. I used BASFILE to convert the WAV file into string data here, but you can use whatever method you want - the main thing here is the way of calling the API.
- Dav
- THIS CODE IS FOR WINDOWS ONLY -
Code: (Select All) '============
'MEMWAVE.BAS
'============
'Plays a WAV file from memory (string) using Win API call.
'Coded by Dav, MAY/2022
DECLARE DYNAMIC LIBRARY "winmm"
FUNCTION PlaySoundA& (lpszName AS STRING, BYVAL hModule AS LONG, BYVAL dwFlags AS LONG)
END DECLARE
CONST SND_APPLICATION = 128 ' look for application specific association
CONST SND_ALIAS = 65536 ' name is a WIN.INI [sounds] entry
CONST SND_ALIAS_ID = 1114112 ' name is a WIN.INI [sounds] entry identifier
CONST SND_ASYNC = 1 ' play asynchronously
CONST SND_FILENAME = 131072 ' name is a file name
CONST SND_LOOP = 8 ' loop the sound until next PlaySound
CONST SND_MEMORY = 4 ' lpszSoundName points to a memory file
CONST SND_NODEFAULT = 2 ' silence not default, if sound not found
CONST SND_NOSTOP = 16 ' don't stop any currently playing sound
CONST SND_NOWAIT = 8192 ' don't wait if the driver is busy
CONST SND_PURGE = 64 ' purge non-static events for task
CONST SND_RESOURCE = 262148 ' name is a resource name or atom
CONST SND_SYNC = 0 ' play synchronously (default)
wav$ = Basfile$ 'load wav data string
PRINT "Playing wave file from memory."
PRINT
PRINT "Press any key to stop sound and exit...."
'Play a sound from memory data...looping it...
x& = PlaySoundA(wav$, 0, SND_MEMORY OR SND_ASYNC OR SND_LOOP)
SLEEP
x& = PlaySoundA(CHR$(0), 0, SND_MEMORY) '<<<--- stop sound
FUNCTION Basfile$ () 'Coyote howl .WAV file converted with BASFILE.BAS
A$ = ""
A$ = A$ + "haIYkm7JKTWUWInWSUSMhfKHPUIPMXWVIXkVdTVdQ4L2f47\g4\=FHK\>IS4"
A$ = A$ + "FJUF9T4B89:AE5EAm;ZRZ:Z2E29T4B8QT#2;S=f6K\3fT#B8QT#29Q4BXkVd"
A$ = A$ + "\c`d<m#?LkO];km77L7L__O[Bo`fYgM^kDCCWnE_jm[_O[gkckkkKFJVKNco"
A$ = A$ + "n[N^cii6ognkST<k7mgL^cM^O2l?oG?oi`ok?iLoEWkOlO8ko`_6hAloon9L"
A$ = A$ + "bO>DUTLN6_c_Q?E2mCdn9L>?biMTTUUA?3N0lKdW8;[X8SN27;;;lX1jAFAE"
A$ = A$ + "CCEFPSUVVVQC#BAEA6T^X\VQUUY2Gfd9SW8=UPVEaRiDhIhT=;g\E=3ZP;iJ"
A$ = A$ + ">GNC:F\E_NediXHeK\ka7]QAhKlIOd7o5c4gJ[kmX3KZBC[gmn_n]?\NlanI"
A$ = A$ + "WkLo\[4`Lg7oh3KZc;FLWWl^gm`Ja^b?kWlCniS5:g^goNkDECD[n1_h[Oc]"
A$ = A$ + "=GmloW?goY?jFI:_c]gOm:i;fjPWme_m^UR>aOgOm?mSVH=f2=KgXJm^koXG"
A$ = A$ + "oE_l`2a_iWm;oUOb4NB:JV_HU>kLgWmfgnX=D3?cEnl;LUKj>LJ6YL=gkQ_j"
A$ = A$ + "[NcSfb:[o5_e=6oJS?U;_a5ZNh;NoOhm?KgR\9S69`bghROjWMUiRWOoGnko"
A$ = A$ + "ngoPf:4YYTdhSLc?mGngm5;`dkiOgOnK_G5Z8A9E]<i3Oc;Nn[jV\jQ?me?k"
A$ = A$ + "PJZl2BBL4QGJjK<O8fl=Jg^A9[2ej]mjUHl=eHC\DJcV]:9ATP#Mm7m^G^Sh"
A$ = A$ + "RGjcWH=YVmZ#_j\;6?oaOcOleMBM[aVL=aZ=dSL[[=MhR?lknc_^Nli_YKb:"
A$ = A$ + "M;C<kWOnKTXicoSOgm=3_\?VV7\K^EnToVOah4KmEo`Gg;c2c6:oa_l1E3Na"
A$ = A$ + "Oa_j6TmNbCgTggRn5glI_j0aIo]OdeB^n[nWNTiBGhCV<C_GmnkKjn;_h2B7"
A$ = A$ + "lEOcA:^7kB^hjMgm=l>nHcC_mgl?o]KA>gE^fZbMfZJf5_a]2XO`KnZkE>KP"
A$ = A$ + "ebT[M;=oSmK>o\dKm^odkjAiN6?LmN`mJVNj;LQIbfn1?mPlYmi;SejKgPem"
A$ = A$ + "4Gg3Gg7oZSc5Lj[=OVZ7Lkf<;>aeMcfkY_maMhl=o21Id<4Bjc38g=>nX^jI"
A$ = A$ + "S6QD_BESD;<nhcWZjmNgKfC9`Lc7BMSkNkJIVoZGM1b6gia7F8e:;iW^lf7^"
A$ = A$ + "A^<nF92OiekF8[WIV;P#c3PmP9FMeDFkmT7]9W[?oS_hb2m^g3ge:5#\`n?n"
A$ = A$ + "AK[^fe_hELUbXA[bJ<4TbEgih3J:5IQK=WgdB66ZRl\\BF=gHSFFL92heGXT"
A$ = A$ + "T\R`7#::j5ZeZII=jh1l7>5]TVR0MF2JUR]F_K5ah[^TWX\VU[EBS=C:BAS2"
A$ = A$ + "U:J8T9LP#9Id:E_NeR6:RLdTTDDd\`GPPF4e;D^LA;MINZd9BT<3UPAa:5ei"
A$ = A$ + "Y8I4e<d1fIHHiUDeeeP?Oi8CU891SP\ZV^I>[REZEaB<CHO[^Fhd\bZ`Ga2:"
A$ = A$ + "Fej\NW:j<YR4:JB2::b\IYhT=bG8_YV\Mb6Df1hOIXYXXHh5aI5hUd<cWg#V"
A$ = A$ + "SRPPT5f6;0i3H5ebIUCCPV8340DE1cQUUGa8WY:b_cb:29;ThIi#FTVR8;59"
A$ = A$ + "5[P<>O2?lO=<1Mbc#3:1RMB2P3cQBlPB2a9Z2?65#PoX\VZ4;IjDIX4ecG<_"
A$ = A$ + "^83fb4iI#V?B=Z#b;AI8>X`CU9=1ST>H4`O<39_:\RaU=EbddBV5:TC5Y#15"
A$ = A$ + "MMEAFb\T\BJ66J#n=8>:2I7iAaO>PXY1:N8:QT=X72DH2RZV#P6UC4L1V\YC"
A$ = A$ + "U>;4^ed=de0_2R0BP=AC1RPV3iPPXAn5TY5U#6WdE#2UZe9o<oYc[;:iTe7R"
A$ = A$ + "1<#2GFL6G#`X4g`?1Ho1A628<Z0BGG3ig2LXTf#83Ue6T>bL`fLFBJnni[U`"
A$ = A$ + "TaKH#IaAB2N5`UA?G2iXXo4#52]hllh:5h:0bb`FAJlVBl^LK;AL#a2#_hG7"
A$ = A$ + ";7T[8IG81I?fUR`Ba^`SS?kDWZOi=k#SXS[fW\C03;KWbClHODdA?HMRHS7E"
A$ = A$ + "2c^Xg`#i`2XXMdfV3Z0HoBZX#<jc7l:BOaS[JbI7<kC^?of6oP:`3=OK]HGQ"
A$ = A$ + "M0IW:_B3n9:N2I8egH`UY?Aik1Uf?K]oAnOi?93SnBWaok7d57J:H:3G;`L>"
A$ = A$ + "b>#7J>6TmB=:BQ=IDeOdG=<D`WihTEhg6n0dd:?T^2BC0OK0I:ha_>\Wd<OY"
A$ = A$ + "b5=5YB5;D`XIh#91T44TecG6:CWG8EPEF`UWX<6UZE]PV0_Jaf0HQNJQWnRO"
A$ = A$ + "b_iBcCDJcmfZA>AN]Vgni_mUk[kmBoROj?ocMAFKgK_CCCAQL[oPgmnG^9k\"
A$ = A$ + "OlOmOe_H<o:MfKg>5D4=JNd[NoK?b:`UoKoYolc?KL]jMKGab\#[mOb[OaAU"
A$ = A$ + "ROSOkOk_lcV:0S9HLi;gN_7lbGodM=SN[_hglK_d]lUREF;GUe?hQ_l=?oXj"
A$ = A$ + "\nWKRa^jTci9#\<LFM?jY_mM_h>]DB7`mLC=a4C>cB1bXgihWmfgmlKGG6bg"
A$ = A$ + "4?TWKM];MUYmBGkhglkoM_JoR\#jidYChOQ97OJ?Y<ghQ_60KDD6]eT9Qk9_"
A$ = A$ + "lEW9X#S3NdC^o>e=P4XTddIS]f:[j?6]FaJ=JfNm=je^THhI6kbCiS]bVk]I"
A$ = A$ + "=EbDI4:\nnkge8a2GoJgLeTL:jVi[^nN7Ok>B1Vi6c6BZn6=UFKZaVd[bnOk"
A$ = A$ + "ofob[J4OZ;NiKi?==lQ>WNm]fKmLTaRcDH[S?\L`;ncn_lKL9OlgoojOi9im"
A$ = A$ + "?mD[#FXI5e<1G;:[ANEbX1RbGohGmZMIVnSniObbiNlomoegE?l4GhZ[`gHW"
A$ = A$ + "]ZYaaKDYIIne^eeW=NYknfWe8lHOd7?Ifmn^ogo?NVYW;mKo2GI;fZZ6=1SN"
A$ = A$ + "ef=bA6LU0D5giPf<^^hWlU;ZL_OhoiOL?f5_fEG8KieKXT`_oD:ejeaR`kRn"
A$ = A$ + "XZ\gMfDag4GLLo5Ndgo3?>W_[Ma[7dHSmJ[4O]#d`Cg]#Ri7Oj0:KLlfjQ^e"
A$ = A$ + "eV:Pemo^oiGg<i<S=^7f:]Qb_1R#UOc3gY<G4_nB[gLcfJaGNf529fjfgKo:"
A$ = A$ + "La37W=GmjFdQFaG6cfk\EQD;=m]FUYm3Okcja^le7g5Ae3OdaUR=chGOQTVm"
A$ = A$ + "^maKGAUWGBFT>nZ;hbMX\bi[e^CcZ5bYSb:cU=dRglV;6R[b^go1KWW:F2nB"
A$ = A$ + "MkF8iDOj_n;FPKSWn^W]>OXeR[eiPmK#kj;o\;_0Aa]>l`]KE>_Y^#fh1341"
A$ = A$ + ":J[8b#bXgL_Sg]LfU_aDN5KO`>5B_bRNYKmT_n5M9Vm:GIN01lQ]UR^jZaDJ"
A$ = A$ + "OhMfb:S_UmVBYHA5R8QBbGJSmgZ4Y_5G>2?\UYG1V0;]H0j2MjEG;C#_nC8D"
A$ = A$ + "ZkF[GEQ<Nh898X1Hn4Y9X5=:F_Im:Fj#iK6RH[iamZQb8T_e6Kd^ZU6:_U0I"
A$ = A$ + "<O^M_FL6E[2i]b1HZ[D0fQhgOL6S:]KEF9Kd#ABaZU_Li26b\Ic#`X0aW^]:"
A$ = A$ + ":4KiIWeM2eVK_M3UD13VD4]E^RDj#126;33DY2:_ZSB?0k#A5g=PBnJl49RW"
A$ = A$ + "2PoDXH>9bT9c:HFYFI3^D134WBBGCP:MJ:iBMg\M1Q<aRV8;_X0MZHaBA[T_"
A$ = A$ + "LUb5`0=8cT>3hKJP5S0aQ#S;Q0L1OY1`B#H8T\[09bAU=;]PJ^RUbKXP0<P`"
A$ = A$ + "U`CC0X8#MjDZBilJ#YDX#?0F3Q0`<G>3=ETU[:aT:\OoQCc3#e:WG70M9Q#o"
A$ = A$ + "d7^P8je[2_??EZhaRWRPR1EY7`PEX4`^02P5X>La?03Dn2FjRXe40BSUUQ4M"
A$ = A$ + "jTY8iah^0D#0N:A4D5MD7J<h>dPg1B13QLB0I4PSA3mfIXUbE^FUl:\ICW6X"
A$ = A$ + "S0gAc:IDXL9He1`M1h4T5I#XT81H>8iidU9^T:Z^96I:9=6J4P75nOH40XEJ"
A$ = A$ + "B<4YBA`:KF03<3H1:7`356bBa[HJIUC7P?Pa4P#A1#G09HJQ`AIG>G`6[3Zh"
A$ = A$ + "20O3`a2<jdNZ]RA#OLPQ084I`L:?0Z1N_XCe9WbM>o7KH\>##hiko7i]am8e"
A$ = A$ + "7E32l9D<BAZO9LaAkee6>RPC7c31SPA60QL6K\B:8c#Ff1?b0\HPI8>0IdP:"
A$ = A$ + "ofFV8JO>2J6o8o`ET]MFTh]mFA9<fYn5mi`=XcgW=inmckP=ZOIk1A1WXT=O"
A$ = A$ + "S2Oa14PmQ98L2fLHL49MB\734^]B7ZYnbJ0>?KKNhC6RIaAnS04Q_?LYcZ[A"
A$ = A$ + "A7?0mXd9\[cjkWl]565Mh90AaO6fL\bANRS6`k2]a=b=lhCDDe=#P[IA]CAB"
A$ = A$ + "chPe4g6FnlidQVGbT:Ej<X_=#d1DB5[D]B1Mn\9S6>::_;J?=leNaZ=JeXT6"
A$ = A$ + "MR0[hfKDX3:dJ_ZEUFK\gNm:;4cc<C>mBQcbSfC9KFKcSNlcN`FVaWO\_hRG"
A$ = A$ + "OY8D2X?Ed[]cSNkkOmAUB=gUn\?oZck?55H^RFM>n5_oKOinFaWK\;nUC<g:"
A$ = A$ + "QPT?\6]>hY_k[OmMJ`7deDC>e<^FNEoA8DZ_oSOckNaa]d8R\f:;=o]VJjIm"
A$ = A$ + "T#[kMOiKOemg\\:\7Q>a:CMi;>f\ab]cCOc;_kjFRl:i:VSfgTOnWN9GI[Nd"
A$ = A$ + "cOnMG?W0WJaJEeC]`Enl;?ObLm>HoNUeTd:f\E5ih;>i4c5R_HcjiUIX5;]a"
A$ = A$ + "QkeDH]Y^jDNI[0UmY2i;2OcknR7_>c2SMUISKf^SEVELi9CUklfgM\EXIVJY"
A$ = A$ + "DV=Z`_f=WdEZ:gm[nVkG<QWEBXe\CnTgl;^h\4]OjgnV]hli>RfVgk`B1^d_"
A$ = A$ + "jgL;j=OegnT:aGLaHi?lAg>gZGlSobE<^m[NF7RUVe;o6?jAmb>mi_P;QmOk"
A$ = A$ + "k_SlRGM2_JkodkF`gU?o4AKlRod_K?Zi^b41;LhMkTjjOj5VSKogoWOKc4c?"
A$ = A$ + "m:2Mg_;glGhC7?LeWlkoj]IFIN_2m^cN6;OnOeiGDk^o^o`mDm>m<aZLl3jA"
A$ = A$ + ">eWn9CVISgn7OAU8c<]G]mNd]eGhloj;7\fcoQ_oHQUVHjhe>j>=RN]?i2^4"
A$ = A$ + "?hKnnWG9n2c5>oNgY;aeohOmeBdn5OgG]1ibc0VfC>bHYco[^PkL?lgmeK#\"
A$ = A$ + "`D;b^m;Oe6a_j7oYc9Nk_m?L7iUWHBoi?nIk;hjBOiLL7l]oY7K^j4S]Xh>?"
A$ = A$ + "i8EGOai_N\F_h7n^S0M>E\bk_O1oGkc_RKe3oZoYkK6HfiRGnh7]IfaoX?jB"
A$ = A$ + "n[lho`g^7kbC>7ij?iIKBNc;lIG?Ac7mVkH6Jni3Uk`Wo`Z1_fi_TKUmOa;g"
A$ = A$ + "Rcc=W;JQm^cfJQVO6?<]^cmjbiM>GQefj1g]FlY_bh[X\kcoZkG8bLg`EVBK"
A$ = A$ + "]C=6o;_B<UVK_EAb#1B8GKS=ZBkNb9LUZlQ?in]H3\d:I:\eQmdR^\;_YeKd"
A$ = A$ + "]<CXE3#F4`[fPacdC]HZ2kLdVVYlj9#F0NgVF4nG=8QN]6iY3jNeHb]_mMfd"
A$ = A$ + ":UkIV?P#Smf_]JL_[4P#_a6[GR?IT4d:i\<48R7;SDQ6=:8V>BhT0jd^M[X#"
A$ = A$ + "4=JBJI[2VBXSA#d\HI;IZdYb#;KJZbS>=2JaLEKF_PDfhARUQEFg4QE0Z:V["
A$ = A$ + "#N=^<9RUTP5Z0Z;10lU<:E_Z1EXElh?970MYT639]LQJe\HR\bb[4RdXFkjF"
A$ = A$ + "2TTlVeJFEW`[[im4S_H[^];K8;YHHI:C6M]e2VPBfZ4Ddf:OQl020jTA25:J"
A$ = A$ + "JJAX?Z6]KEcBV1#JUUR6go5ULa>Kf[V>Mb4IH4UiB7d[_8<5jMkSf^4K\0Q9"
A$ = A$ + "Db3Hf2i1RL6]fNkfi5bV>[PQU1G2ONl6QD[LS6U=UhhTdc3QQ\AFcGPhdb6i"
A$ = A$ + "bIRnU3MD<lIRhO]0#7M:ViAo\\#X?4b4JE?[PPVIF\Jc>8DajRT91LA1RTT2"
A$ = A$ + "1\ZBmV]JDY04992_bR;]J4:S6K]gf];1^[\V^2CD?^FHUH2U0?XNNE840aOQ"
A$ = A$ + "H;=md^2aGYgf[GF12e6EJe^\#HGgh6c7P:Gmf]ZVg#7eZINEZX[^h2N2VRC_"
A$ = A$ + "Dm6=ZE^Da2FVZ\9l]`<ci>4E^FK^cV];3He18K2I2\h\c]L`\j=gNoMkEcB5"
A$ = A$ + "1IAP:^_UFHieB[DOk3?HS:jl0<9`dX2kNn5F=Q4dkdF=<5IiDbG]NAQ8;<=0"
A$ = A$ + "gW]#[eQe<55cbX5?A`fVLVEB8T_FmJU;FZF[>][G#8nbC=neWcG:ibMgJ[N]"
A$ = A$ + "ZG]Je:5eb^j=^dG<nR9ekL`Akg[F1;X[_ZjILOm;?fdNcJeNkMfXEeB517AG"
A$ = A$ + "P8TkiWOYeB`XG^ej[g^N9;30c6GfXNGJA?1C;FXE_e[WGGEc\#YRjD1VOZYF"
A$ = A$ + "0<^fmjD[#>;dVU:ZYlLc9_UKLCge[D\#i6Mke]N>VPc=nHC^DL`[gOW^E<ed"
A$ = A$ + "cG]AESd;=nU^flATZ]i^Ke^JA0\JYLBYmiJ6GNSSPiG1R`UZDYD>5NHQfWWE"
A$ = A$ + "G;:YBYFMJFD7260DHC^8;>eD^2cIE[I3Xe2ESRPJ=iC7bcB;_JXD\Z5JdMSN"
A$ = A$ + "=;IX2eCe49l?oDgLADG;k_g6=:JZ3kkPHobX5:2UR=kd^IebX5E=AZ4nM_TK"
A$ = A$ + "8HHD]C_>#\8W90<U>^_5G`M`dlj#L\NU2`FC0f90??`b^FdG2FcZ]k21^li;"
A$ = A$ + "EdBU;ChEMkNe0a9U\ZgMc=keZ\1jh<YB^f2c<kbQX;\a]_cQ`F3M0\X89dKg"
A$ = A$ + "dck;U4dldfKd^Fi2idTH9R^Z[iFHeHd6=fnf7]Gg:iTQ698B6ao:[h;<doDk"
A$ = A$ + "M>Lo=ZK9ACT9;5IbP[jaK82EHgenmZJRBC`cC5gkB;1=K9E\mFK313C51<jh"
A$ = A$ + "d[]T[UmWB^fF7N`F=\TH1TnB\am<k=WeC<QZkLlMf[C9M9NNAA^<1#ka3CW["
A$ = A$ + "cN7MhVe1[PVVUQ<^g5L]T_4REgnhk^O;;A:2B>9IVX^WK^U33]YN_kM#klB<"
A$ = A$ + "#_#:b\#?];h9<YI[MACGa0<>D[^TAl\`BNSaELS3?JgFi11c0TICh5g0\NCd"
A$ = A$ + "XH:YRDWX\#f#^M]Xg4BEf4EeG50;c;[Yb6cclck>4Y>jcmF5D18m0X8AVT[i"
A$ = A$ + "f=:WCm=gMkf5]iFE4Ta2;]6b]gOg>5E]?fH5b#;kJYeBRJMM[^Ec1HgA7N9O"
A$ = A$ + "j0^GNe`IE[\n>KgYR9di50QGR918IOaH<Z_a>KRE87PhGV>2TPIehXnSQ_]E"
A$ = A$ + "iaM>Y;THUiVMiPPe1Y7JF#C2O`RLPTGLieB`V[iVk\A3;INl9>bUfoB;h>4Q"
A$ = A$ + "Bi^K_cjEd5#`jU152kkPH7hQ7\KW2bh8Z64XGIQ5m6W?Ok]gMSJVBXn?UUQd"
A$ = A$ + "O[jIe`4#VP]g^K53Xi7`I`TGI]HDJEj^e6=;Z9RKb0b81KU2TTeXFgNM#KI#"
A$ = A$ + "=YX8#5ckbN2TR?G]>MKEb#B0gQ47A4O[h=D6al=F_G[BjRhSdDV=E`EaWYDU"
A$ = A$ + ">mPPW<jLkTUh9C4dgJQQ>f;18#[0=iSa[cAU:B`##jM8;Jcj5=D#1491FB0g"
A$ = A$ + "J4X;K]2E[E]4T55gS3dBKdPQRQh^AkVXS?0eWT83DS`[oX4#ibF0I8[4Z_7F"
A$ = A$ + "bDA2h?DLXEnb=Je\FACEla?W=Ml`137WP7B^gYEUL`70XcTU>Cd0[1#C5]Ze"
A$ = A$ + "^5H9bH0j8Q4<#hT#Ia:=JF_D>=L7ELd4a37:LR\8EfYIIC5AlI`cT6c=]JYV"
A$ = A$ + "MkD_X>j4nQ6kY#EV0OG_2TAXFN=9L[1\IS72ZGUNXQ`S`l3L7J=8BaIF[cj]"
A$ = A$ + "`e7AC>0FK#1`<28W\1\8h\nB6?8HfI40c6YAdGXbZbL4AmkcO<BLN\ZFZP?2"
A$ = A$ + "MA83IQ`eHe:S]JIT<D6LR2L6UKfZ>DQD4MD[Z#eo`n34U#8G]fPESZI1UWd4"
A$ = A$ + "9S5H]0a8U;PG30\jB#3^:P63h?HL:ilePh44#`b#V==FSDZ5a[_8cCYoIHPV"
A$ = A$ + ";Eaj=PJg#C]8^1bA240]91Uj67W#bF6h>04X0k[NmbiDU#74\Q^4ERPn36S#"
A$ = A$ + "`\BmJUbY:S6=Q^Z04F34>19j49Z2;jbBhY3a3T32;Th3ZXPQ2JL>Hc>F#P<]"
A$ = A$ + "Bn:E;3k:]931ZHQ2618KE^J9;dWYhQo`V9:\nVRA=OU:XmC8ZX:19aKRIEcG"
A$ = A$ + "^LaLJ:X1hX[:B1XW2WPP3O8EVJ::hIM;BW2]gV0fKKCFFaF8YR42fbSV07#f"
A$ = A$ + "fK<d`29B2BPLiBiAU^0Z6ZfN3#F7Z^TgD3#IX[[9cR<K7bU`Ta3=RafK0b56"
A$ = A$ + "Q\8RLXXY#PX:KC6M#52dYS5>Ldd<BV8^cQ6mT6Vkh0iDDRPUD^X5Jh#X_cH9"
A$ = A$ + "B49LD\\;G1TR^=g8bHkfN2S6JfZT5mM3n3K4<C<g`V4AFWnDiPFlLl7T\i8C"
A$ = A$ + "69LhhIHaTk;49^\X0KL<gHQ0^n0ba`Lk8KdD0#29TS#0T]i<<#3f2n`1]<47"
A$ = A$ + "P#S>^]RFV>TQD<Q1Q`8I0Q`2fTEUi]3:99i1dg8#1j8U:;015lZ62NJ1K^A="
A$ = A$ + "ZcPlN#WX3E3MlUfBA2kVQS1hYeb10\]0#^8bLTYR5>B\d8P[8YP`o2TiYB7?"
A$ = A$ + "Jdh8b8QW7Ag0\#j<90bYXh?3iH0Idi[Q5NOb49R69JB26A]n\SV\2=1:3K<K"
A$ = A$ + "YD\HATAR>QQ\Pk7:Jb\XIf281kCV<Ml8X58T3E\42[K>3``YbP4N2T`cQ9W7"
A$ = A$ + "4^4XcTaR41Ki#<70^1^Z^2:SLl8P>9iE<QM5Ua\[>Dh\XH^3I7MJ;L#WPD6`"
A$ = A$ + "=FWI#FN1\`cQ?J4\>SU:[m9MF^HN\5BCT:^So3OC0h7;HQ8c#V9I\X8YP>^E"
A$ = A$ + "0M<Jo_\0;DM075cRfK1UN0PGjXSnTR0MHZPDT<0b8lHPoP;VT8F\hXC<=OiJ"
A$ = A$ + "eZD4I:L\dTXeRHP79W[4Z06BWl0IT=RFAQ_QZF_6Zm49dlLQBB8G:;TYX2J>"
A$ = A$ + "mi`3<fVm8`^85XhCSJU\#V2;3=VmHY#WiJm6e;3I5`WUWcRAF<NDPMD]:N`H"
A$ = A$ + "bRRj>BY9`>HRl3H7n`5JM\9T4fdA:X=6X?GD1Hi=ZQ]5KY43]a0BF0Xi[F2C"
A$ = A$ + "6\5`C7DY^NM\7Ic>lmBX8>\S\5d1PbQU>FYj5a\3V^]=RfZW0maHI\dea\cJ"
A$ = A$ + "7fQhUNQ:XX>TF4OlYXhK<XYCIXm?Xc6TdaTa\3[6Z#JkZ33<IcT<Nl4#od6#"
A$ = A$ + ">Zbh59NLl=ERh9P_H#I6#k0DAWI;VNBd5M0J;]<TW7=U2\H#lW8EFF#[U]cA"
A$ = A$ + "S538nDhk>1jTg[0[eh[JP=mDY9IQmSUa69Ni`Fl8fE]IgIi0IUYBV:;B[hDS"
A$ = A$ + "ff>=Xed9CJ;6h;<lF3di3BSIWP6MaX6b>3J59MZ<TX_OQlGf^:WM#8]mh1`Y"
A$ = A$ + "BA1BdPXI0aWVP6UF3Hgd1N37Vm<f\Sj74O;3h`QHPMd9_3I76A:D0IdUd0UG"
A$ = A$ + "3jHJ4fcT9;=?:UTUmR:_SaTQ0Mg8#7P?T>bV>bW#\;XHHQ>FCEkS67K<I`g?"
A$ = A$ + "RLiQVoejOCbL^Z2RZVf\[hLY1PNR8#:E;W5:Od9HWT1TN>ll16Q\mH3#7l0F"
A$ = A$ + "Yh11P]Ad5Q0M[<6856\D`BgNV<fgk08>R\AJ>9ESL>\KOBoTP]h85Tdk;6T="
A$ = A$ + "R^n48YP53VNOfAG>5TD>1kIA\KP;IH?d0\WRRSSJS>BY_aH>T<Go`^8VM\Dj"
A$ = A$ + "[DLP1L9C7URYK[D^Q:efW#cNQT6JWAgV<Nh4XQMP>LJ6kkMS3M4k3U>^8h8B"
A$ = A$ + "93FjhcfFcQ>BY8K4e:W^3IiQ635Ze:mQ\?#jlf3gaFYf63ff5aGS5ME7[Q7O"
A$ = A$ + "2jDfgY6Snl317TaS_l#XA3R8[<dWX0YS#F>PM\aCTU4C73gANHTl4dE6\\J7"
A$ = A$ + "b68Nd;8LBa[Y>Rhk?c`ndE`c[Q1MiQ`3DB73LbnnSP6cT3ME]QT5\WO8869<"
A$ = A$ + "^c1FS3M>7j:SHm8[QC4OoS\Sl>kQQHS=MEWUK7jhkQdXR__Ja\ggJTkkEhkh"
A$ = A$ + "ST]EZ<HY2=VaA\Bl=AbfL`3k3?U\nT79hdOjI>gEXQFYj8gW9Knk;NKWZo>4"
A$ = A$ + "Z1FY3M97jDXK<VLoHSLo]g3]NenTQe#deHc98hH=H_eAlH[di6=9i\Tk#7_8"
A$ = A$ + "i<Y9kPf`;0EoK_3\oVJ#X__d?imUBen2C=REfG[8jbHiQYSMZn\gO2Pfg6[n"
A$ = A$ + "c#\oM6J#`ai2m>:MD\DdFK37T8JL_XIH?:kfdY]795V^Tc5Q2CWQ[?mnF9V^"
A$ = A$ + "chGMXKgO??GokAEOaH?8DDiA4MW1c9eo6?Q5_=MWIAJKm3X?H6UmYS^dJ3hO"
A$ = A$ + "#`L`lAabOhUHVcI0\>;ZfF_\mmEK4jmigNlc3_bc>SEeNHc\S<bdnS7]ohon"
A$ = A$ + "0da:##LDcdNlf\lS#_ON4fCa^b9\OWaL:;gOLc>fo9XK?ELkk\]cCTMT_ClY"
A$ = A$ + "omlFJ`W:hh9k9Y;i`_3M7c\_mHkH>cLFI`]aSUm\dafIOiHCFeI<jl37LZmH"
A$ = A$ + "dEM>f8k5NWa[K?<MW;H8WSmKoIhPT9>gBm1?h4d7HomcI8HOSnhLV_lYYk<g"
A$ = A$ + "Lini<\ELo;?Pl9Ygofago1>9m6\TeoCGk;n87[S1=be04SIb9b=Ri?d1j_7e"
A$ = A$ + "A<BBWTn0mn1Y?`c>QL>9MF7mNB1i\WFjd6DomjW`3`X4?SP47AaWA1h#g8d?"
A$ = A$ + "m;8MjUPA4TdYhOd7<`B?a;<d3h7nidXd7m_Z3S#GL`=\HXY>l1LWV^STh6\i"
A$ = A$ + "J4;EH`M6iTFj`]SRWHgk7dD57n2Wf56i_77WbW?]YN29=Z;LJ9=jgISn2W98"
A$ = A$ + "=b;8n1XO2KEDLdPaIl]oMe`Il=79m1YcOJ5LB1mSXiQGWTQoMZY_6>U;`oQL"
A$ = A$ + "Q?XV7ABoHV:oI<engXVcZiANQ?\YNb[43F>OPGHT7l1d#oK2cIl1nC8XCm2W"
A$ = A$ + "T^S6n`V:o7dD7AcSN5NnaY?j3T>[T>]Y:nO0mCKAWBcRo8J^oO7\>;m1o>ee"
A$ = A$ + ";JD1eo2BM21MZGh4^V`O92j7CcO0j2WVn?j;LR[D^d8?h4dU>aKLjk]e09mQ"
A$ = A$ + "\dODGh3nPoSNQcXJQ1Jn3l2oXVjI^jISBo3:Xc8Y1G`\o_dTngEeo5JBooV?"
A$ = A$ + "l1N`O1do;k5na=Yo?HD2%%h1"
btemp$ = ""
FOR i& = 1 TO LEN(A$) STEP 4: B$ = MID$(A$, i&, 4)
IF INSTR(1, B$, "%") THEN
FOR C% = 1 TO LEN(B$): F$ = MID$(B$, C%, 1)
IF F$ <> "%" THEN C$ = C$ + F$
NEXT: B$ = C$: END IF: FOR j = 1 TO LEN(B$)
IF MID$(B$, j, 1) = "#" THEN
MID$(B$, j) = "@": END IF: NEXT
FOR t% = LEN(B$) TO 1 STEP -1
B& = B& * 64 + ASC(MID$(B$, t%)) - 48
NEXT: X$ = "": FOR t% = 1 TO LEN(B$) - 1
X$ = X$ + CHR$(B& AND 255): B& = B& \ 256
NEXT: btemp$ = btemp$ + X$: NEXT
Basfile$ = _INFLATE$(btemp$): btemp$ = ""
END FUNCTION
|
|
|
|
| Can't Convert an INT to a String |
|
Posted by: TarotRedhand - 05-22-2022, 10:51 AM - Forum: Help Me!
- Replies (4)
|
|
What is wrong with this line -
Code: (Select All) TempString$ = LTRIM(STR$(AYear%))
All variables are DIMed yet I get an Illegal string-number conversion error on that line. FWIW removing LTRIM has no effect on the error. This is driving me nuts.
Thanks
TR
|
|
|
|
| Load Image 256 |
|
Posted by: Petr - 05-22-2022, 08:16 AM - Forum: Programs
- Replies (1)
|
 |
Hi again.
This function is designed for you to load any image into 8-bit format. I used Ashish's conversion feature, which he published a long time ago, to convert. Here I did not try to speed it up, but to make it work so that any 32-bit image could actually be used as an 8-bit image.
The whole issue of 8-bit images faces one major drawback. If you do anything on an 8-bit screen, you have to compare the color palettes of all the images used so that they are the same and there is no color swapping. Thus, to make sure that, for example, the yellow color in one 8-bit frame does not have a palette number of, for example, 50, but in another frame else number. This needs to be considered when using 8-bit images.
Code: (Select All) 'LOADIMAGE256 experimental ver. 2.0
'1] Load image as 32 bit image
'2] find how much colors image contains. If 256 and less, continue. If more than 256, use Ashish's Dithering program, convert source image to 256 colors and call function LOADIMAGE256 again
'3] create 8 bit image and color palette
'4] THE PROGRAM DOES NOT RESPECT THE DEFAULT Qb64 COLOR PALETTE, Each image has its own!
Screen _NewImage(1700, 800, 256)
img8 = LOADIMAGE256("be.png")
_CopyPalette img8, _Dest
_PutImage (0, 0), img8
Function LOADIMAGE256 (img$)
DefLng A-Z
CompressIntensity = 5
image = _LoadImage(img$, 32)
ReStart: 'if image contains more than 256 colors, is function restarted after Floyd Steinberg Dithering is done by Ashish's function.
ReDim m As _MEM, clr8(255) As _Unsigned Long, Clr32 As _Unsigned Long, test As Long, s As Long
For s = 0 To 255
clr8(s) = 99999
Next s
m = _MemImage(image)
Do Until p& = m.SIZE
_MemGet m, m.OFFSET + p&, Clr32~&
test = 0
'this block prevent for writing the same color more than 1x to palette array
Do Until test > 255
If clr8(test) = Clr32~& Then GoTo NextColor
If clr8(test) = 99999 Then Exit Do
test = test + 1
Loop
'if is empty place in palette, save this color as next palette color
If test > 255 Then
Print "Image contains more than 256 colors, can not be directly copyed as 8 bit image. Using ASHISH's source for dithering... Compress intensity: "; CompressIntensity
img2 = FloydSteinbergDithering(image, CompressIntensity)
CompressIntensity = CompressIntensity - 1
_FreeImage image
image = img2
GoTo ReStart
End If
clr8(test) = Clr32
'color is saved as palette for 8 bit image
NextColor: p& = p& + 4
Loop
image8 = _NewImage(_Width(image), _Height(image), 256)
'set palette
Dim N As _MEM, C As _Unsigned _Byte
N = _MemImage(image8)
For palett = 0 To 255
_PaletteColor palett, clr8(palett), image8
Next
'create 8 bit mask (set colors 0 to 255 to 8 bit image)
For C = 255 To 0 Step -1
clr~& = clr8(C)
R& = 0
R8& = 0
Do Until R& = m.SIZE
_MemGet m, m.OFFSET + R&, Clr32
If Clr32 = clr~& Then _MemPut N, N.OFFSET + R8&, C
R& = R& + 4
R8& = R8& + 1
Loop
Next C
LOADIMAGE256 = _CopyImage(image8, 256)
_MemFree m
_MemFree N
_FreeImage image
_FreeImage image8
End Function
Function FloydSteinbergDithering& (img&, factor As Integer) 'This is not my source, its coded By Ashish
preDest = _Dest
preSource = _Source
Img32 = _CopyImage(img&)
_Dest Img32
_Source img&
For y = 0 To _Height(img&) - 1
For x = 0 To _Width(img&) - 1
col~& = Point(x, y)
oldR = _Red(col~&)
oldG = _Green(col~&)
oldB = _Blue(col~&)
newR = _Round(factor * (oldR / 255)) * (255 / factor)
newG = _Round(factor * (oldG / 255)) * (255 / factor)
newB = _Round(factor * (oldB / 255)) * (255 / factor)
errR = oldR - newR
errG = oldG - newG
errB = oldB - newB
col2~& = Point(x + 1, y)
r = _Red(col2~&) + errR * 7 / 16
g = _Green(col2~&) + errG * 7 / 16
b = _Blue(col2~&) + errB * 7 / 16
PSet (x + 1, y), _RGB(r, g, b)
col2~& = Point(x - 1, y + 1)
r = _Red(col2~&) + errR * 3 / 16
g = _Green(col2~&) + errG * 3 / 16
b = _Blue(col2~&) + errB * 3 / 16
PSet (x - 1, y + 1), _RGB(r, g, b)
col2~& = Point(x, y + 1)
r = _Red(col2~&) + errR * 5 / 16
g = _Green(col2~&) + errG * 5 / 16
b = _Blue(col2~&) + errB * 5 / 16
PSet (x, y + 1), _RGB(r, g, b)
col2~& = Point(x + 1, y + 1)
r = _Red(col2~&) + errR * 1 / 16
g = _Green(col2~&) + errG * 1 / 16
b = _Blue(col2~&) + errB * 1 / 16
PSet (x + 1, y + 1), _RGB(r, g, b)
PSet (x, y), _RGB(newR, newG, newB)
Next x, y
_Dest preDest
_Source preSource
FloydSteinbergDithering& = Img32
End Function
|
|
|
|
| Knapsack 0-1 & rosettacode & qbasic qb64 & WE |
|
Posted by: DANILIN - 05-22-2022, 06:09 AM - Forum: Programs
- Replies (3)
|
 |
Knapsack 0-1 & rosettacode & qbasic qb64 & WE
For all people: send yours algorithms to rosettacode
otherwise forum may disappear even in google search
Classic Knapsack problem is solved in many ways
Contents: http://rosettacode.org/wiki/Knapsack_problem
Long read: rosettacode.org/wiki/Knapsack_problem/0-1
Previous topics and long programs: Knapsack
https://qb64forum.alephc.xyz/index.php?topic=3091
Ordered Combinations Generator
https://qb64forum.alephc.xyz/index.php?topic=2999
My newest program synthesizes all ciphers from 0 & 1
adding an extra register and 0 remain on left in cipher
Number of comparisons decreases from N! to 2^N
for example N=5 N!=120 >> 2^N=32
Random values origin are automatically assigned
quantity and quality and integral of value is obtained
and in general: integral of quantity and quality
and it is possible to divide only anyone will not understand
Program write results to qb64 directory
Code: (Select All) Open "knapsack.txt" For Output As #1
N=7: L=5: a = 2^(N+1): Randomize Timer 'knapsack.bas DANILIN
Dim L(N), C(N), j(N), q(a), q$(a), d(a)
For m=a-1 To (a-1)/2 Step -1: g=m: Do ' sintez shifr
q$(m)=LTrim$(Str$(g Mod 2))+q$(m)
g=g\2: Loop Until g=0
q$(m)=Mid$(q$(m), 2, Len(q$(m)))
Next
For i=1 To N: L(i)=Int(Rnd*3+1) ' lenght & cost
C(i)=10+Int(Rnd*9): Print #1, i, L(i), C(i): Next ' origin
For h=a-1 To (a-1)/2 Step -1
For k=1 To N: j(k)=Val(Mid$(q$(h), k, 1)) ' from shifr
q(h)=q(h)+L(k)*j(k)*C(k) ' 0 or 1
d(h)=d(h)+L(k)*j(k)
Next
If d(h) <= L Then Print #1, d(h), q(h), q$(h)
Next
max=0: m=1: For i=1 To a
If d(i)<=L Then If q(i) > max Then max=q(i): m=i
Next
Print #1,: Print #1, d(m), q(m), q$(m): End
Main thing is very brief and clear to even all
Results is reduced manually:
Code: (Select All) 1 2 17
2 2 14
3 2 17
4 1 11
5 2 18
6 3 14
7 3 10
5 73 1101000
4 62 1100000
2 28 0100000
5 81 0011100 !!!
3 45 0011000
5 76 0010010
2 36 0000100
5 81 0011100
|
|
|
|
| Whoops. Apologies. It's fixed now. LOL! |
|
Posted by: admin - 05-21-2022, 10:31 PM - Forum: Announcements
- Replies (5)
|
 |
What can I say besides, "Whoops!"
I told you guys all this forum stuff was new to me with setting it up and all. Apparently for the last month or so, it's been impossible to send emails via the server here, or for the server itself to send any emails. (Which, I guess makes it a good thing that nobody had to click a confirmation message for their email when signing up...)
The issue is really rather simple. (And quite embarrassing to admit to.
Our mail server is: mail@forums.qb64phoenix.com
The server we used: mail@forums.qb64phoenix.co
Only one little difference in those two things there, just it does make a weeee small difference. LOL!
Worst thing is we worked with 0 error reports anywhere. As far as the forums were concerned, they did their job. Collect the messages, send them to the remote server, let it deliver them
As far as our actual server was concerned, it never got crap, therefore nothing was ever wrong. And as for the qb64phoenix.CO guys... They don't exist, so they didn't return any mail or report any errors.
So, all I can offer i my apologies. I didn't even realize we had an issue until an user reported they weren't getting mail notifications when they couldn't log in with a forgotten password. The issue should be fixed now, and I've tested sending messages to myself and a few other people, so all should work as expected from now on.
Only one thing to really note: We're sending messages properly now, but that still isn't going to stop your mail provider from labeling posts from here as spam and sending it to your junk mail or trash folders. Be on the lookout for messages in those places, if you ever do request to reset a password or such, and the forum has to mail you about the issue. 
|
|
|
|
| TCP/IP Printing |
|
Posted by: AtomicSlaughter - 05-21-2022, 09:53 PM - Forum: Utilities
- Replies (2)
|
 |
Code: (Select All) Sub TCPPrint (IP As String, Port As String, toPrint As String)
CRLF$ = Chr$(10) + Chr$(13)
x = _OpenClient("TCP/IP:" + Port + ":" + IP)
toPrint = toPrint + CRLF$
Put #x, , CRFF$
End Sub
Sub TCPEndPrint (IP As String, Port As String)
CRFF$ = Chr$(10) + Chr$(12)
x = _OpenClient("TCP/IP:" + Port + ":" + IP)
Put #x, , CRFF$
End Sub
Use the first sub to send the data, then when finished send the second sub and it will initiate the form feed and spit the sheet out.
|
|
|
|
| Space(d) Invaders! |
|
Posted by: Cobalt - 05-21-2022, 09:44 PM - Forum: Works in Progress
- Replies (2)
|
 |
SI_ResourcePack_1.MFI (Size: 2.1 MB / Downloads: 65)
With the weather what it is the past 2 days around my place I have taken a bit of a rest from workin to code a little something. Though its not quite done I thought I might share it with you folks and see what you think of it so far.
Space Invaders 2022.
Controls are pretty basic;
Right and Left arrow keys move your defense cannon.
Space bar shoots.
it does track your score, but there is only the initial wave to fight off. Its pretty bare bones at the moment too, so there is only the one scale and no options.
It has some issues with the invaders freezing from time to time. Almost like a time stop special, which I wish I could say was the intent.  But alas I haven't quite figured out why they freeze for a very specific amount of time!
There is also the occasional collision issue where your shot will pass through an Invader. Probably because I'm using a very VERY basic POINT approach to detecting if the shot hits an Invader, so if it happens to find one of the blank pixels in the invaders then it will tend to miss. Just haven't added a secondary POINT detection to help fix that.
The Invaders also cannot hit you with their weapons yet, so your invincible at the moment.
Beyond some special graphical elements I would like to add that about all that is left to finish.
Don't forget the MFI file too.
Code: (Select All) 'Space Invaders 2022
'Cobalt
'QB64
TYPE Invader
X AS INTEGER
Y AS INTEGER
Type AS INTEGER
END TYPE
TYPE Player
X AS INTEGER 'where player is
Y AS INTEGER
Shot_X AS INTEGER 'where player's shot is
Shot_Y AS INTEGER '(only 1 at a time allowed)
Hit_X AS INTEGER
Hit_Y AS INTEGER
Hit_Time AS INTEGER
Special AS _BYTE
END TYPE
TYPE Shot
X AS INTEGER
Y AS SINGLE
Type AS _BYTE
END TYPE
TYPE Impacts
X AS INTEGER
Y AS INTEGER
Time AS _BYTE
END TYPE
TYPE Game
Lives AS _BYTE
Level AS _BYTE
Score1 AS LONG
Score2 AS LONG
HScore AS LONG
Frame AS _BYTE
Remain AS _BYTE 'invaders remaining
Speed AS _BYTE
Difficulty AS _BYTE
Win AS _BYTE
UFO AS _BYTE
UFO_Shot AS _BYTE
END TYPE
CONST TRUE = -1, FALSE = NOT TRUE
CONST Key_Right = 19712, Key_Left = 19200, Key_Up = 18432, Key_Down = 20480
CONST Key_Space = 32, Key_Enter = 13
DIM SHARED G AS Game, I(11, 5) AS Invader, P AS Player, P_Shot AS _BYTE
DIM SHARED Layer(8) AS LONG, SFX(16) AS LONG, BGM(4) AS LONG
DIM SHARED Shots(17) AS Shot, Shot_Count AS _BYTE, Hits(16) AS Impacts, Hit_Count AS _BYTE
DIM SHARED Ex AS Invader, Exploding AS _BYTE, UFO AS Invader
'init
RANDOMIZE TIMER
SCREEN _NEWIMAGE(640, 700, 32)
_SCREENMOVE 10, 5
Layer(0) = _DISPLAY
Layer(1) = _NEWIMAGE(640, 700, 32)
'Layer(2) = _LOADIMAGE("invaders.bmp", 32)
'Layer(3) = _LOADIMAGE("spaceinvaders.bmp", 32)
'Layer(4) = _LOADIMAGE("si_cpo.bmp", 32)
'Layer(5) = _LOADIMAGE("invaddx.bmp", 32)
Layer(6) = _NEWIMAGE(640, 700, 32) 'console build layer
Layer(7) = _NEWIMAGE(640, 700, 32) 'shield layer
Layer(8) = _NEWIMAGE(640, 700, 32) 'invader layer
'SFX(1) = _SNDOPEN("SI_shoot.wav")
'SFX(2) = _SNDOPEN("SI_invaderkilled.wav")
'SFX(3) = _SNDOPEN("SI_Explode.wav")
'SFX(4) = _SNDOPEN("SI_fastinvader1.wav")
'SFX(5) = _SNDOPEN("SI_fastinvader2.wav")
'SFX(6) = _SNDOPEN("SI_fastinvader3.wav")
'SFX(7) = _SNDOPEN("SI_fastinvader4.wav")
'SFX(8) = _SNDOPEN("SI_ufo_highpitch.wav")
'SFX(9) = _SNDOPEN("SI_ufo_lowpitch.wav")
MFI_Loader "SI_ResourcePack_1.MFI"
_SNDVOL SFX(1), .5
_SNDVOL SFX(2), .5
_SNDVOL SFX(3), .5
_SNDVOL SFX(4), .5
_SNDVOL SFX(5), .5
_SNDVOL SFX(6), .5
_SNDVOL SFX(7), .5
_SNDVOL SFX(8), .5
_SNDVOL SFX(9), .5
_CLEARCOLOR _RGB32(0), Layer(3)
_CLEARCOLOR _RGB32(4), Layer(3)
_CLEARCOLOR _RGB32(4), Layer(5)
_CLEARCOLOR _RGB32(0), Layer(7)
TAnimate& = _FREETIMER
TSound& = _FREETIMER
ON TIMER(TSound&, .3682) Play_BGS
ON TIMER(TAnimate&, .256) Flip_Frame
_TITLE "Space Invaders 2022"
_DELAY .25
'Build Arcade Console
_PUTIMAGE (0, 0)-STEP(639, 499), Layer(2), Layer(6)
_PUTIMAGE (0, 0)-STEP(639, 499), Layer(5), Layer(6)
_PUTIMAGE (0, 500)-STEP(639, 199), Layer(4), Layer(6), (0, 0)-STEP(5999, 1799)
SI_Print "p1-score", 192, 204, Layer(6)
SI_Print "hi-score", 288, 204, Layer(6)
SI_Print "p2-score", 384, 204, Layer(6)
'--------------------
FOR i%% = 0 TO 3
_PUTIMAGE (160 + 100 * i%%, 352)-STEP(23, 15), Layer(3), Layer(7), (254, 31)-STEP(23, 15)
NEXT i%%
G.Frame = FALSE
G.Remain = 55
G.Speed = 30
P.X = 164: P.Y = 380
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).X = 96 + 32 * x%%: I(x%%, y%%).Y = 320 - 20 * y%%: I(x%%, y%%).Type = y%% + 1
NEXT x%%, y%%
TIMER(TAnimate&) ON
TIMER(TSound&) ON
ClearLayerTrans Layer(8)
DO
_PUTIMAGE , Layer(6), Layer(1)
_PUTIMAGE , Layer(7), Layer(1)
FOR y%% = 0 TO 4: FOR x%% = 0 TO 10
PlaceInvader x%%, y%%
NEXT x%%, y%%
IF Move_Counter%% >= G.Speed THEN Move_Counter%% = 0: Move_Invaders
IF INT(RND * 100) >= 75 THEN Invader_Shot
IF NOT G.UFO THEN
IF INT(RND * 100) > 90 THEN
IF Last_UFO%% > 120 THEN 'Only 1 out of 120 ufos appear
Last_UFO%% = 0: Start_UFO
ELSEIF Last_UFO%% <= 120 THEN
Last_UFO%% = Last_UFO%% + 1
END IF
END IF
ELSEIF G.UFO THEN
Move_UFO
Draw_UFO
END IF
Move_Invader_Shot
Draw_Invader_Shot
IF Hit_Count THEN Age_Impacts 'if any hits then age them
IF P.Hit_Time THEN Age_Impact_Player
IF P_Shot THEN Move_Player_Shot
Draw_Impacts
IF P.Hit_Time THEN Draw_Impact_Player
Nul%% = Controls
IF P_Shot THEN Draw_Player_Shot
Draw_Player
IF Exploding THEN Draw_Explode_Invader
Display_Scores
_PRINTSTRING (0, 0), STR$(Last_UFO%%), Layer(8)
_PUTIMAGE , Layer(8), Layer(1)
_PUTIMAGE , Layer(1), Layer(0)
ClearLayerTrans Layer(8)
_LIMIT 60
Move_Counter%% = Move_Counter%% + 1
IF Nul%% = TRUE THEN ExitFlag%% = TRUE
IF G.Remain = 0 THEN ExitFlag%% = TRUE: G.Win = TRUE
LOOP UNTIL ExitFlag%%
STOP_ALL_SNDs
TIMER(TSound&) OFF
TIMER(TAnimate&) OFF
IF G.Win THEN SI_Print "you win!", 288, 304, Layer(0)
SUB Start_UFO
G.UFO = TRUE
IF INT(RND * 100) > 49 THEN
UFO.X = 112
UFO.Type = TRUE
_SNDLOOP SFX(8)
ELSE
UFO.X = 512
UFO.Type = FALSE
_SNDLOOP SFX(9)
END IF
UFO.Y = 224
END SUB
SUB Move_UFO
IF UFO.Type THEN 'moving left to right
UFO.X = UFO.X + 1
ELSE 'moving right to left
UFO.X = UFO.X - 2
END IF
IF INT(RND * 100) > 50 THEN UFO_Shoot
IF UFO.X < 112 OR UFO.X > 512 THEN
_SNDSTOP SFX(8): _SNDSTOP SFX(9)
G.UFO = FALSE
END IF
END SUB
SUB Draw_UFO
_PUTIMAGE (UFO.X, UFO.Y)-STEP(15, 7), Layer(3), Layer(8), (210, 39)-STEP(15, 7)
END SUB
SUB UFO_Shoot
IF UFO.X - 8 >= P.X AND UFO.X + 8 <= P.X + 16 AND G.UFO_Shot = FALSE THEN
Shots(Shot_Count).X = UFO.X + 8
Shots(Shot_Count).Y = UFO.Y + 8
Shots(Shot_Count).Type = 6
Shot_Count = Shot_Count + 1
G.UFO_Shot = TRUE
END IF
END SUB
FUNCTION Controls
Result%% = FALSE
IF _KEYDOWN(Key_Right) THEN
P.X = P.X + 2
IF P.X >= 500 THEN P.X = 500
END IF
IF _KEYDOWN(Key_Left) THEN
P.X = P.X - 2
IF P.X <= 128 THEN P.X = 128
END IF
IF _KEYDOWN(Key_Space) AND P_Shot = FALSE AND P.Hit_Time = 0 THEN Player_Shot
IF _KEYHIT = 27 THEN Result%% = TRUE
Controls = Result%%
END FUNCTION
SUB Player_Shot
_SNDPLAY SFX(1)
P_Shot = TRUE
P.Shot_X = P.X + 7
P.Shot_Y = P.Y
END SUB
SUB PlaceInvader (X%%, Y%%)
SELECT CASE I(X%%, Y%%).Type
CASE 0 'Dead
CASE 1, 2
IF G.Frame THEN
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (246, 1)-STEP(15, 7)
ELSE
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (246, 11)-STEP(15, 7)
END IF
CASE 3, 4
IF G.Frame THEN
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (228, 1)-STEP(15, 7)
ELSE
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (228, 11)-STEP(15, 7)
END IF
CASE 5
IF G.Frame THEN
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (210, 1)-STEP(15, 7)
ELSE
_PUTIMAGE (I(X%%, Y%%).X, I(X%%, Y%%).Y)-STEP(15, 7), Layer(3), Layer(8), (210, 11)-STEP(15, 7)
END IF
END SELECT
END SUB
SUB Move_Invaders
STATIC Direction%% 'direction of invader movement
DIM Score(11) AS _BYTE 'track how many invaders are in each column
IF Direction%% THEN 'TRUE
'move all invaders regaurdless of exsistance
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).X = I(x%%, y%%).X + 3
Score(x%%) = Score(x%%) + I(x%%, y%%).Type 'monitor how many invaders are in each column
NEXT x%%, y%%
FOR z%% = 10 TO 0 STEP -1 'check right to left if moving right
IF Score(z%%) THEN 'if there are still invaders in this Column
IF I(z%%, 0).X >= 528 THEN
Direction%% = NOT Direction%% 'reverse invader movement
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).Y = I(x%%, y%%).Y + 4 'lower invaders each pass
NEXT x%%, y%%
END IF
z%% = -1 'good column so quit after move
END IF
NEXT z%%
ELSE 'FALSE
'move all invaders regaurdless of exsistance
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).X = I(x%%, y%%).X - 3
Score(x%%) = Score(x%%) + I(x%%, y%%).Type 'monitor how many invaders are in each column
NEXT x%%, y%%
FOR z%% = 0 TO 10 'check left to right if moving left
IF Score(z%%) THEN 'if there are still invaders in this Column
IF I(z%%, 0).X <= 96 THEN
Direction%% = NOT Direction%% 'reverse invader movement
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
I(x%%, y%%).Y = I(x%%, y%%).Y + 4 'lower invaders each pass
NEXT x%%, y%%
END IF
z%% = 11 'good column so quit after move
END IF
NEXT z%%
END IF
END SUB
SUB SI_Print (Txt$, X%, Y%, L&)
L%% = LEN(Txt$)
FOR i%% = 1 TO L%%
SELECT CASE ASC(MID$(Txt$, i%%, 1))
CASE 32
X% = X% + 6
CASE 45
_PUTIMAGE (X%, Y%)-STEP(7, 7), Layer(3), L&, (220, 119)-STEP(7, 7)
X% = X% + 8
CASE 48 TO 57
_PUTIMAGE (X%, Y%)-STEP(7, 7), Layer(3), L&, (1 + (ASC(MID$(Txt$, i%%, 1)) - 48) * 10, 146)-STEP(7, 7)
X% = X% + 8
CASE 97 TO 122
_PUTIMAGE (X%, Y%)-STEP(7, 7), Layer(3), L&, (1 + (ASC(MID$(Txt$, i%%, 1)) - 97) * 10, 137)-STEP(7, 7)
X% = X% + 8
END SELECT
NEXT i%%
END SUB
SUB Display_Scores
SI_Print LTRIM$(STR$(G.Score1)), 192, 214, Layer(1)
SI_Print LTRIM$(STR$(G.HScore)), 288, 214, Layer(1)
SI_Print LTRIM$(STR$(G.Score2)), 384, 214, Layer(1)
END SUB
SUB Shot_Impact (id%%)
Hit_Count = Hit_Count + 1
Hits(Hit_Count).X = Shots(id%%).X - 2
Hits(Hit_Count).Y = Shots(id%%).Y
Hits(Hit_Count).Time = 30
END SUB
SUB Shot_Impact_Player
P.Hit_X = P.Shot_X - 2
P.Hit_Y = P.Shot_Y - 3
P.Hit_Time = 30
P_Shot = FALSE
END SUB
SUB Invader_Shot
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
IF I(x%%, y%%).Type THEN 'make sure invader is alive
IF INT(RND * 100) >= 99 THEN 'random chance of shot
IF INT(RND * 5) = 3 THEN
IF Shot_Count < 15 THEN 'is there room for a shot?
Shots(Shot_Count).X = I(x%%, y%%).X + 8
Shots(Shot_Count).Y = I(x%%, y%%).Y + 4
Shots(Shot_Count).Type = INT(RND * 3) + 1
Shot_Count = Shot_Count + 1
END IF
END IF
END IF
END IF
NEXT x%%, y%%
END SUB
SUB Move_Invader_Shot
FOR i%% = 1 TO Shot_Count
Shots(i%%).Y = Shots(i%%).Y + Shots(i%%).Type / 2
IF Shots(i%%).Y > 400 THEN 'ground\bottom of screen, remove shot
Shots(i%%).Type = 0
Shots(i%%).Y = 0
FOR z%% = i%% TO Shot_Count
SWAP Shots(z%%), Shots(z%% + 1)
NEXT z%%
Shot_Count = Shot_Count - 1
END IF
IF Collide_Invader_Shot(i%%) THEN 'did the invader's shot hit a sheild or player?
Shot_Impact i%%
IF Shots(i%%).Type = 6 THEN G.UFO_Shot = FALSE
Shots(i%%).Type = 0
Shots(i%%).Y = 0
FOR z%% = i%% TO Shot_Count
SWAP Shots(z%%), Shots(z%% + 1)
NEXT z%%
Shot_Count = Shot_Count - 1
END IF
NEXT i%%
END SUB
SUB Move_Player_Shot
P.Shot_Y = P.Shot_Y - 3
IF P.Shot_Y <= 200 THEN Shot_Impact_Player
Test%% = Collide_Player_Shot
IF Test%% = 1 THEN Shot_Impact_Player 'cause impact GFX to display
IF Test%% = TRUE THEN P_Shot = FALSE 'Invader explodes and shot stops
END SUB
SUB Explode_Invader (x%%, y%%)
_SNDPLAY SFX(2)
G.Remain = G.Remain - 1
Ex.Type = 24
Ex.X = I(x%%, y%%).X
Ex.Y = I(x%%, y%%).Y
Exploding = TRUE
END SUB
SUB Draw_Explode_Invader
Ex.Type = Ex.Type - 1
IF Ex.Type = 0 THEN Exploding = FALSE
_PUTIMAGE (Ex.X, Ex.Y)-STEP(15, 7), Layer(3), Layer(1), (264, 1)-STEP(15, 7)
END SUB
SUB Draw_Impacts
FOR i%% = 1 TO Hit_Count
IF Hits(i%%).Time >= 2 THEN
_PUTIMAGE (Hits(i%%).X, Hits(i%%).Y)-STEP(5, 7), Layer(3), Layer(7), (270, 21)-STEP(5, 7)
ELSE
_PUTIMAGE (Hits(i%%).X, Hits(i%%).Y)-STEP(5, 7), Layer(3), Layer(7), (277, 21)-STEP(5, 7)
END IF
NEXT i%%
_CLEARCOLOR _RGB32(1), Layer(7)
END SUB
SUB Draw_Impact_Player
IF P.Hit_Time > 1 THEN
_PUTIMAGE (P.Hit_X, P.Hit_Y)-STEP(5, 7), Layer(3), Layer(7), (270, 21)-STEP(5, 7)
ELSE
_PUTIMAGE (P.Hit_X, P.Hit_Y)-STEP(5, 7), Layer(3), Layer(7), (277, 21)-STEP(5, 7)
END IF
END SUB
SUB Draw_Invader_Shot
STATIC Frame AS _BYTE, FC AS _BYTE
FOR i%% = 1 TO 15
SELECT CASE Shots(i%%).Type
CASE 0 'no shot
CASE 1
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (210 + 5 * Frame, 21)-STEP(2, 7)
CASE 2
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (230 + 5 * Frame, 21)-STEP(2, 7)
CASE 3
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (250 + 5 * Frame, 21)-STEP(2, 7)
CASE 6
_PUTIMAGE (Shots(i%%).X, Shots(i%%).Y)-STEP(2, 7), Layer(3), Layer(1), (250 + 15 * Frame, 21)-STEP(2, 7)
END SELECT
NEXT i%%
FC = FC + 1
IF FC = 7 THEN Frame = Frame + 1: FC = 0
IF Frame = 4 THEN Frame = 0
END SUB
SUB Draw_Player
_PUTIMAGE (P.X, P.Y)-STEP(15, 7), Layer(3), Layer(1), (210, 49)-STEP(15, 7)
END SUB
SUB Draw_Player_Shot
_PUTIMAGE (P.Shot_X, P.Shot_Y)-STEP(2, 7), Layer(3), Layer(1), (250, 21)-STEP(2, 7)
END SUB
FUNCTION Collide_Invader_Shot%% (id%%)
IF _SOURCE <> Layer(7) THEN _SOURCE Layer(7)
IF _RED32(POINT(Shots(id%%).X, Shots(id%%).Y + (3 + (INT(RND * 6) - 3)))) > 1 THEN Result%% = TRUE
Collide_Invader_Shot = Result%%
END FUNCTION
FUNCTION Collide_Player_Shot%%
IF _SOURCE <> Layer(7) THEN _SOURCE Layer(7) 'check for shield impact
IF _RED32(POINT(P.Shot_X, P.Shot_Y)) > 1 THEN Result%% = 1
_SOURCE Layer(8) 'then check for invader hit
IF _RED32(POINT(P.Shot_X, P.Shot_Y)) > 0 OR _RED32(POINT(P.Shot_X, P.Shot_Y + 1)) > 0 THEN 'see which invader was hit
FOR y%% = 0 TO 4
FOR x%% = 0 TO 10
IF P.Shot_X >= I(x%%, y%%).X AND P.Shot_X <= I(x%%, y%%).X + 16 AND P.Shot_Y >= I(x%%, y%%).Y AND P.Shot_Y <= I(x%%, y%%).Y + 8 THEN
'found invader being hit
Hit_Invader x%%, y%%
y%% = 5
x%% = 11
Result%% = TRUE
END IF
NEXT x%%, y%%
'UFO being hit?
IF P.Shot_X >= UFO.X AND P.Shot_X <= UFO.X + 16 AND P.Shot_Y >= UFO.Y AND P.Shot_Y <= UFO.Y + 8 THEN
_SNDPLAY SFX(2)
Ex.Type = 24
Ex.X = UFO.X
Ex.Y = UFO.Y
Exploding = TRUE
Result%% = TRUE
G.Score1 = G.Score1 + 100
_SNDSTOP SFX(8): _SNDSTOP SFX(9)
G.UFO = FALSE
END IF
END IF
Collide_Player_Shot = Result%%
END FUNCTION
SUB Hit_Invader (X%%, Y%%)
STATIC Speedup AS _BYTE
SELECT CASE I(X%%, Y%%).Type
CASE 1, 2
G.Score1 = G.Score1 + 10
CASE 3, 4
G.Score1 = G.Score1 + 20
CASE 5
G.Score1 = G.Score1 + 30
END SELECT
Explode_Invader X%%, Y%%
I(X%%, Y%%).Type = 0
Speedup = Speedup + 1
IF Speedup = 2 THEN Speedup = 0: G.Speed = G.Speed - 1
END SUB
SUB Age_Impacts
FOR i%% = 1 TO Hit_Count
Hits(i%%).Time = Hits(i%%).Time - 1
IF Hits(i%%).Time = 0 THEN
Hits(i%%).Time = 0
Hits(i%%).Y = 0
FOR z%% = i%% TO Hit_Count
SWAP Hits(z%%), Hits(z%% + 1)
NEXT z%%
Hit_Count = Hit_Count - 1
END IF
NEXT i%%
END SUB
SUB Age_Impact_Player
IF P.Hit_Time THEN 'if the player has an impact out there.
P.Hit_Time = P.Hit_Time - 1
END IF
END SUB
SUB Flip_Frame
G.Frame = NOT G.Frame
END SUB
SUB ClearLayer (L&)
old& = _DEST
_DEST L&
CLS ' ,0
_DEST old&
END SUB
SUB ClearLayerTrans (L&)
old& = _DEST
_DEST L&
CLS , 0
_DEST old&
END SUB
SUB Play_BGS
STATIC current_sound AS _BYTE
SELECT CASE current_sound
CASE 0
_SNDPLAY SFX(4)
CASE 1
_SNDPLAY SFX(5)
CASE 2
_SNDPLAY SFX(6)
CASE 3
_SNDPLAY SFX(7)
current_sound = -1
END SELECT
current_sound = current_sound + 1
END SUB
SUB STOP_ALL_SNDs
FOR i%% = 0 TO 9
_SNDSTOP SFX(i%%)
NEXT i%%
END SUB
SUB MFI_Loader (FN$)
DIM Size(128) AS LONG, FOffset(128) AS LONG
OPEN FN$ FOR BINARY AS #1
GET #1, , c~%% 'retrieve number of files
FOR I~%% = 1 TO c~%%
GET #1, , FOffset(I~%%)
GET #1, , Size(I~%%)
FOffset&(I~%%) = FOffset&(I~%%) + 1
NEXT I~%%
Layer(2) = LoadGFX(FOffset(1), Size(1)) 'invaders
Layer(3) = LoadGFX(FOffset(2), Size(2)) 'spaceinvaders(sprites)
Layer(4) = LoadGFX(FOffset(3), Size(3)) 'console control board
Layer(5) = LoadGFX(FOffset(4), Size(4)) 'cabnet decal
SFX(1) = LoadSFX(FOffset(5), Size(5)) '_SNDOPEN("SI_shoot.wav")
SFX(2) = LoadSFX(FOffset(6), Size(6)) '_SNDOPEN("SI_invaderkilled.wav")
SFX(3) = LoadSFX(FOffset(7), Size(7)) '_SNDOPEN("SI_Explode.wav")
SFX(4) = LoadSFX(FOffset(8), Size(8)) '_SNDOPEN("SI_fastinvader1.wav")
SFX(5) = LoadSFX(FOffset(9), Size(9)) '_SNDOPEN("SI_fastinvader2.wav")
SFX(6) = LoadSFX(FOffset(10), Size(10)) '_SNDOPEN("SI_fastinvader3.wav")
SFX(7) = LoadSFX(FOffset(11), Size(11)) '_SNDOPEN("SI_fastinvader4.wav")
SFX(8) = LoadSFX(FOffset(12), Size(12)) '_SNDOPEN("SI_ufo_highpitch.wav")
SFX(9) = LoadSFX(FOffset(13), Size(13)) '_SNDOPEN("SI_ufo_lowpitch.wav")
CLOSE #1
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
END SUB
FUNCTION LoadGFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadGFX& = _LOADIMAGE("temp.dat", 32)
END FUNCTION
FUNCTION LoadFFX& (Foff&, Size&, Fize%%)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadFFX& = _LOADFONT("temp.dat", Fize%%, "monospace")
END FUNCTION
FUNCTION LoadSFX& (Foff&, Size&)
IF _FILEEXISTS("temp.dat") THEN KILL "temp.dat"
OPEN "temp.dat" FOR BINARY AS #3
dat$ = SPACE$(Size&)
GET #1, Foff&, dat$
PUT #3, , dat$
CLOSE #3
LoadSFX& = _SNDOPEN("temp.dat")
END FUNCTION
|
|
|
|
|
