Print Page - 🎄🎁✨ Holiday Season

Title: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 06, 2020, 01:20:53 pm

🎄☃️ Lights and jingly bells are already all around. It's time to start submitting your 2020 holiday samples! Let's group them under this thread, who'll start? ✨🎁

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 06, 2020, 01:52:31 pm

Hi Fellippe. I have done 0 rows of the code :). Some conditions, or it is in free style?

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SpriggsySpriggs on December 06, 2020, 02:13:00 pm

Any requirements?

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 06, 2020, 02:28:35 pm

Make it beautiful, preferably with no extra files.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: OldMoses on December 06, 2020, 04:38:14 pm

Christmas 2020..... I don't think I'm quite up to flaming Xmas trees... :D

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 06, 2020, 08:05:11 pm

To start decorating you'll need some ornaments, how about ones that rotate color?

Code: QB64: [Select]

_TITLE "Ornaments with Rotating Colors, spacebar to change color set" '  B+ 2018-04-17
'from figosdev post at http://smallbasic.sourceforge.net/?q=node/1684#comment-1955
'translating fig to SmallBASIC for alittle cross pollination...
'2020-12-05 for Xmas decorating a little update
 
CONST xmax = 600, ymax = 600
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM SHARED rrr, ggg, bbb, ccc
cx = 300
ww = 3.14159 / 2 'fix to return back to this after each run
setRGB
WHILE 1
    IF INKEY$ = " " THEN setRGB: ccc = 0
    ccc = 0
    w = ww 'fix
    llc = llc + 1
    IF llc = 32000 THEN llc = 0: lc& = 0
    FOR r = 490 TO 300 STEP -.25
        e = w - _PI / 4 / (490 - 300)
        tmp = e: e = w: w = tmp
        FOR p = _PI(-1) TO _PI STEP _PI(1 / 101)
            e = INT((COS(w) * 380) / 2)
            x = INT(COS(p * 2) * e + cx)
            y = INT(SIN(p * 2) * e + r - 50)
            lc& = lc& + 1
            IF lc& MOD 90 = 0 THEN
                ccc = ccc + .2
                fcirc x, y, 12, changeRGB~&
            END IF
        NEXT
    NEXT
    _DISPLAY
    _LIMIT 10
WEND
 
SUB setRGB 'mod
    rrr = RND ^ 2: ggg = RND ^ 2: bbb = RND ^ 2
END SUB
 
FUNCTION changeRGB~& 'mod
    changeRGB~& = _RGB32(127 + 127 * SIN(rrr * ccc), 127 + 127 * SIN(ggg * ccc), 127 + 127 * SIN(bbb * ccc))
END SUB
 
'from Steve Gold standard
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
 
 
 

Looking for Andy's pine tree maker code to put them on.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 06, 2020, 08:07:46 pm

Thanks for getting it started, bplus!

Minor typo at line 30: I changed it by adding _DEFAULTCOLOR as the last parameter to fcirc. You may wanna review it.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 06, 2020, 08:09:49 pm

Was that before I changed it in edit because I posted old version?

I changed changeRGB to a function and the old version had a call to a SUB before the call to old circle routine that didn't take color.

The version I edited should work.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 06, 2020, 08:11:00 pm

If there are no bugs in the latest version, then you've fixed it. 😄

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 06, 2020, 08:43:18 pm

Here is my Merry Christmas 2020 submission. I worked on this all afternoon. :) It has random falling glowing snow (I didn't need help this time! LOL), random hills, and random tiny Christmas Trees. Everything changes every 7 seconds. Enjoy!

Edit: I just added a photo of it.

Code: QB64: [Select]

'Merry Christmas! From SierraKen
'Made on December 6, 2020.
 
DIM snowx(2000), snowy(2000)
DIM yy AS SINGLE
DIM cx AS INTEGER
DIM cy AS INTEGER
DIM r AS INTEGER
DIM c AS _UNSIGNED LONG
DIM hills AS LONG
DIM c1 AS SINGLE
DIM c2 AS SINGLE
DIM c3 AS SINGLE
DIM hillx AS SINGLE
DIM sz AS SINGLE
DIM shape AS SINGLE
DIM tx AS SINGLE
DIM ty AS SINGLE
DIM col AS SINGLE
 
_TITLE "Merry Christmas! From SierraKen - Every 7 seconds new mountains and trees appear. Press Esc to quit."
RANDOMIZE TIMER
scene = _NEWIMAGE(800, 600, 32)
SCREEN scene
start:
FOR cc = 1 TO 200
    IF cc + 400 > 600 THEN GOTO nex:
    LINE (0, 400 + cc)-(_WIDTH, 400 + cc), _RGB32(0, c + 100, cc)
NEXT cc
nex:
'Hills
FOR hills = 1 TO 10
    hillx = (RND * _WIDTH)
    sz = (RND * 300)
    shape = (RND + 1)
    c1 = (RND * 155)
    c2 = (RND * 155)
    c3 = (RND * 155)
    FOR size = .2 TO sz STEP .2
        CIRCLE (hillx, 400), size, _RGB32(c1, c2 + size, c3), 2 * _PI, _PI, shape
    NEXT size
NEXT hills
FOR trees = 1 TO 75
    tx = (RND * _WIDTH)
    ty = (RND * 200) + 430
    r = 1
    col = INT(RND * 5) + 1
    IF col = 1 THEN c = _RGB32(255, 0, 0)
    IF col = 2 THEN c = _RGB32(0, 0, 255)
    IF col = 3 THEN c = _RGB32(255, 127, 255)
    IF col = 4 THEN c = _RGB32(127, 255, 255)
    IF col = 5 THEN c = _RGB32(255, 139, 0)
 
    LINE (tx, ty)-(tx + 2, ty - 10), _RGB32(183, 127, 127), BF
 
    LINE (tx, ty - 10)-(tx - 5, ty - 10), _RGB32(127, 255, 127)
    LINE (tx - 5, ty - 10)-(tx, ty - 15), _RGB32(127, 255, 127)
    cx = tx - 5: cy = ty - 10
    fillCircle cx, cy, r, c
    LINE (tx, ty - 15)-(tx - 5, ty - 15), _RGB32(127, 255, 127)
    LINE (tx - 5, ty - 15)-(tx, ty - 20), _RGB32(127, 255, 127)
    cx = tx - 5: cy = ty - 15
    fillCircle cx, cy, r, c
    LINE (tx, ty - 20)-(tx - 5, ty - 20), _RGB32(127, 255, 127)
    LINE (tx - 5, ty - 20)-(tx + 1, ty - 25), _RGB32(127, 255, 127)
    cx = tx - 5: cy = ty - 20
    fillCircle cx, cy, r, c
    LINE (tx + 2, ty - 10)-(tx + 7, ty - 10), _RGB32(127, 255, 127)
    LINE (tx + 7, ty - 10)-(tx + 2, ty - 15), _RGB32(127, 255, 127)
    cx = tx + 7: cy = ty - 10
    fillCircle cx, cy, r, c
    LINE (tx + 2, ty - 15)-(tx + 7, ty - 15), _RGB32(127, 255, 127)
    LINE (tx + 7, ty - 15)-(tx + 2, ty - 20), _RGB32(127, 255, 127)
    cx = tx + 7: cy = ty - 15
    fillCircle cx, cy, r, c
    LINE (tx + 2, ty - 20)-(tx + 7, ty - 20), _RGB32(127, 255, 127)
    LINE (tx + 7, ty - 20)-(tx + 1, ty - 25), _RGB32(127, 255, 127)
    cx = tx + 7: cy = ty - 20
    fillCircle cx, cy, r, c
 
    'Yellow Star
    cx = tx + 1: cy = ty - 26
    r = 1
    c = _RGB32(255, 255, 127)
    fillCircle cx, cy, r, c
NEXT trees
 
hills = _COPYIMAGE(0)
 
DO
    _LIMIT 50
    _PUTIMAGE , hills
    a$ = INKEY$
    IF a$ = CHR$(27) THEN END
    snowing = INT(RND * 1000) + 1
    IF snowing > 900 THEN
        s = s + 1
        IF s > 1500 THEN s = 1
        snowx(s) = (RND * _WIDTH)
        snowy(s) = 0
    END IF
    IF yy > 640 THEN yy = 0
    FOR t = 1 TO 1500
        snowy(t) = snowy(t) + 1
        cx = snowx(t): cy = snowy(t)
        r = RND * 5
        c = _RGB32(255, 255, 255)
        fillCircle cx, cy, r, c
    NEXT t
    _DISPLAY
    CLS
    tim = tim + 1
    IF tim > 500 THEN tim = 0: CLS: _FREEIMAGE hills: GOTO start:
LOOP
 
'from Steve Gold standard
SUB fillCircle (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
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 06, 2020, 08:52:01 pm

Oh today's the 6th, I like that blinking effect with snowfall Ken.

Found Andy's tree, someone might be able to do something with this?

Code: QB64: [Select]

'Original IFS fractal by Andy Amaya   copy 2019-12-09
'ap3-191209-216
_TITLE "IFS Pine Tree"
 
scaleX! = 524.0 '424.0 to 1024.0 look OK for X scaling factor
scaleY! = 524.0
offsetX% = 370
offsetY% = 150
SCREEN _NEWIMAGE(800, 600, 32)
CLS , _RGB32(0, 0, 0)
COLOR _RGB32(0, 228, 0, 24)
 
FOR iter& = 0 TO 1000000
    SELECT CASE RND
        CASE 0 TO .60
            nx! = -0.858985 * lastX! + 0.008944 * lastY! + 0.092336
            ny! = 0.012263 * lastX! + 0.84816 * lastY! + -0.04103
        CASE .60 TO .96
            nx! = -0.373759 * lastX! + -0.353068 * lastY! + 0.296535
            ny! = 0.353068 * lastX! + -0.373759 * lastY! + 0.704598
        CASE ELSE
            nx! = 0.010276 * lastX! + 0 * lastY! + 0.053328
            ny! = -0.05138 * lastX! + 0.313416 * lastY! + 0.576552
    END SELECT
    IF iter& > 20& THEN PSET (nx! * scaleX! + offsetX%, ny! * scaleY! + offsetY%)
    lastX! = nx!
    lastY! = ny!
NEXT
SLEEP
SYSTEM
 

Who me?!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 06, 2020, 09:19:43 pm

Thanks B+ :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 07, 2020, 06:13:39 am

Cool scene, @SierraKen!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: _vince on December 07, 2020, 11:50:02 am

Quote from: SpriggsySpriggs on December 06, 2020, 02:13:00 pm

Any requirements?

What about rewards?

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 07, 2020, 11:53:33 am

What's more rewarding than having your work featured for the whole community to gasp in awe?

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 07, 2020, 12:13:21 pm

Thanks Felippe :).

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Pete on December 08, 2020, 12:12:00 am

Quote from: FellippeHeitor on December 07, 2020, 11:53:33 am

What's more rewarding than having your work featured for the whole community to gasp in awe?

$1.25 American.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 08, 2020, 07:40:24 pm

OK some pine trees in winter:

Code: QB64: [Select]

_TITLE "Pine Trees mod, any key for another scene..." ' b+ 2020-12-08   mod from
'Original IFS fractal by Andy Amaya   copy 2019-12-09
'ap3-191209-216
 
CONST nTrees = 3, sy = 424
REDIM SHARED ox(1 TO nTrees), oy(1 TO nTrees), sx(1 TO nTrees)
SCREEN _NEWIMAGE(800, 600, 32)
COLOR , &HFFFFFFFF
REDIM i AS LONG
DO
    CLS
    FOR y = 0 TO _HEIGHT
        LINE (0, y)-(_WIDTH, y), Ink~&(&HFF332266, &H88FFFFFF, y / _HEIGHT)
    NEXT
    FOR i = 1 TO nTrees
        NewTree i
    NEXT
    FOR t = 1 TO nTrees
        FOR i = 0 TO 40000 ' orig 1 million
            SELECT CASE RND
                CASE 0 TO .60
                    nx = -0.858985 * lastX + 0.008944 * lastY + 0.092336
                    ny = 0.012263 * lastX + 0.84816 * lastY + -0.04103
                CASE .60 TO .96
                    nx = -0.373759 * lastX + -0.353068 * lastY + 0.296535
                    ny = 0.353068 * lastX + -0.373759 * lastY + 0.704598
                CASE ELSE
                    nx = 0.010276 * lastX + 0 * lastY + 0.053328
                    ny = -0.05138 * lastX + 0.313416 * lastY + 0.576552
            END SELECT
            IF i > 36000 THEN
                PSET (nx * sx(t) + ox(t), ny * sy + oy(t)), &HFFFFFFFF
            ELSEIF i > 30 THEN
                PSET (nx * sx(t) + ox(t), ny * sy + oy(t)), &HFF116611
            END IF
            lastX = nx
            lastY = ny
        NEXT
    NEXT
    SLEEP
LOOP UNTIL _KEYDOWN(27)
 
SUB NewTree (i)
    ox(i) = RND * (_WIDTH - 300)
    oy(i) = RND * 100 + 150
    sx(i) = RND * 300 + 624
END SUB
 
SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
    outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
END SUB
 
FUNCTION Ink~& (c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG, fr##)
    DIM R1, G1, B1, A1, R2, G2, B2, A2
    cAnalysis c1, R1, G1, B1, A1
    cAnalysis c2, R2, G2, B2, A2
    Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
END FUNCTION
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 08, 2020, 09:36:51 pm

Word Search for Christmas 2020:

No input files, the list is internal but this code outputs 3 txt files:
1. A word List
2. A Letters Grid to Search Words in
3. A Solution of where the words are.
All these are text files that you can print out from your favorite Text Editor. These files are supplemental paper versions, the game itself you can play entirely on the computer.

"Make it beautiful" ;-)) Well if sound of kids busy with a puzzle is beautiful this might fill the bill. :)

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Word Search for Christmas 2020" 'by b+ mod 2020-12-06 modified from:
' Puzzle Builder #4 sort lists 2020-12-05.bas but no input files!
' 3 output files will be created in case you want kids the play same game from:
' 1. A list of search words
' 2. The Letter Puzzle grid
' 3. Solution of words start location and direction.
 
DEFLNG A-Z
RANDOMIZE TIMER
CONST AscA = 97, WordLengthLimit = 15
CONST ScreenWidth = 1000, ScreenHeight = 640
 
TYPE WordSearch 'having trouble tracking all Global shared variables for puzzle so here is that container
    FileTheme AS STRING ' the theme name for + " Word List.txt" file we are doing
    GridSide AS LONG ' number of letters per side of square grid
    GridSideM1 AS LONG ' grid size - 1
    GridSideP2M1 AS LONG ' grid size ^ 2 - 1
    GridLabel AS STRING ' top and side labeling of letters grid
    NumWords AS LONG ' number of words
    PlaceWordIndex AS LONG ' current index of word we are working
    NumPlacedWords AS LONG ' current number of placed words
    NumUnplacedWords AS LONG 'count the disasters
    UnfilledCellF AS LONG 'there are still unfilled cells F = Flag
    NumBestPlacedWords AS LONG ' best number of placed words here is goal  = NumWords
    Filler AS STRING
END TYPE
 
TYPE WordType
    S AS STRING ' the word  S for String
    Len AS LONG ' it's length
    Placed AS LONG
    X AS LONG ' placements
    Y AS LONG
    D AS LONG ' direction 0 to 7 ie  North, NorthEast, East, SouthEast... NorthWest
END TYPE
 
REDIM SHARED WS AS WordSearch ' this is all shared variables of puzzle in a container
REDIM SHARED Words(1 TO 250) AS WordType ' essential info about each search word
REDIM SHARED AscWord(1 TO 250, WordLengthLimit) ' break the word done to ASC numbers for each letter, speed up processing
REDIM SHARED BestWords(1 TO 250) AS WordType ' best set of words placed
REDIM SHARED AscLetters(0 TO WS.GridSideM1, 0 TO WS.GridSideM1) ' this is the ASC of the letters on the grid
REDIM SHARED AscBestLetters(0 TO WS.GridSideM1, 0 TO WS.GridSideM1) ' this is the ASC of the letters in the Best grid using the most words
REDIM SHARED DX(0 TO 7), DY(0 TO 7), DString$(0 TO 7) ' these are direction "adders" to x, y position to search in directions
REDIM SHARED DirectionTotals(0 TO 7) ' check direction counts for quality puzzle.
 
 
'======================================= Word Search File Base Name and Grid Size ================================================
 
'   Make your word list file with: Some base name for theme + " Word List.txt"
 
' test file 2 Richard Frost started this theme to test his puzzles from which I learned much :)
'WS.FileTheme = "Elements" ' add suffix to your file " Word List.txt"    <<<<<<<<<<<<<<<<<<<<<<<<<    Input
'WS.GridSide = 30 ' <<<<<<<<<<<<<<<<<<<<<<<<<    Input later    30 the maximum grid size
'WS.Filler = "bplus" ' <<<<<<<<<<<<<<< Input a personalization to hide in the puzzle
 
' test file 1  The reason this Word Builder was Built! for the naughty and nice nephews and nieces.
WS.FileTheme = "Christmas 2020" 'add suffix to your file " Word List.txt"   <<<<<<<<<<<<<<<<<<<<<<<<<    Input
WS.GridSide = 19 ' <<<<<<<<<<<<<<<<<<<<<<<<<    Input later    30 the maximum grid size
WS.Filler = "SECRET" ' <<<<<<<<<<<<<<< Input a personalization to hide in the puzzle
 
'' test file 3  check a tiny puzzle
'WS.FileTheme = "The First Four Elements"
'WS.GridSide = 5 ' <<<<<<<<<<<<<<<<<<<<<<<<<    Input later    30 the maximum grid size
'WS.Filler = "BPLUS" ' <<<<<<<<<<<<<<< Input a personalization to hide in the puzzle
 
SCREEN _NEWIMAGE(ScreenWidth, ScreenHeight, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
 
DIM try, c, r, y$, puzzleFiled
 
InitializeOnce
WHILE try < 100 'for long runs uncomment BEEP
    try = try + 1
    RestartPuzzleFill
    IF WS.PlaceWordIndex > 0 THEN ShowPuzzle
    WHILE WS.PlaceWordIndex < WS.NumWords
        WS.PlaceWordIndex = WS.PlaceWordIndex + 1
        WS.UnfilledCellF = 0 ' set F that all are filled
        PlaceWord
        IF WS.UnfilledCellF = 0 OR (WS.NumPlacedWords = WS.NumWords) THEN EXIT WHILE
    WEND
    LOCATE 2, 1: PRINT "Try:"; try
    IF try MOD 25 = 0 THEN _DISPLAY: ShowBestPuzzle
    IF WS.NumPlacedWords > WS.NumBestPlacedWords THEN 'copy Letters$ into Best$
        REDIM AscBestLetters(0 TO WS.GridSideM1, 0 TO WS.GridSideM1)
        FOR r = 0 TO WS.GridSideM1
            FOR c = 0 TO WS.GridSideM1
                AscBestLetters(c, r) = AscLetters(c, r)
            NEXT
        NEXT
        WS.NumBestPlacedWords = WS.NumPlacedWords
 
        FOR r = 1 TO WS.NumWords '                 copy everything because we shuffle each time
            BestWords(r).S = Words(r).S: BestWords(r).Len = Words(r).Len: BestWords(r).Placed = Words(r).Placed
            BestWords(r).X = Words(r).X: BestWords(r).Y = Words(r).Y: BestWords(r).D = Words(r).D
        NEXT
        Sort BestWords()
        IF WS.NumBestPlacedWords = WS.NumWords THEN '    automatic file if all words positioned in puzzle
            ShowBestPuzzle
            LOCATE 37, 1: PRINT " After "; TS$(try); " tries, this complete puzzle was made."
            FilePuzzle
            LOCATE 39, 1: PRINT " Puzzle Filed, next up is word search.";
            LOCATE 40, 1: PRINT "      press any to continue.";
            puzzleFiled = -1
            LOCATE 1, 1
            _DISPLAY
            SLEEP
            EXIT WHILE
        END IF
    END IF
WEND
IF puzzleFiled = 0 THEN
    ShowBestPuzzle
    LOCATE 37, 1: PRINT " After "; TS$(try); " tries, this was best puzzle."
    _DISPLAY
    LOCATE 38, 1: INPUT " Enter y for yes, to save the best to file."; y$
    IF y$ = "y" THEN
        FilePuzzle
        LOCATE 39, 1: PRINT " Puzzle Filed.";
    END IF
    LOCATE 40, 1: PRINT " Next up is word search, press any to continue.";
    LOCATE 1, 1
    _DISPLAY
    SLEEP
END IF
 
' Now to find words in our best puzzle
DIM bestPuz, mx, my, mb, mIndex, wIndex, cnt, hx, hy, wd, sx, sy, navX$, navY$, navD$, i
 
ShowBestPuzzle 'get a snapshot
bestPuz = _NEWIMAGE(ScreenWidth, ScreenHeight, 32)
_PUTIMAGE , 0, bestPuz
WHILE _KEYDOWN(27) = 0
    _PUTIMAGE , bestPuz, 0
    LOCATE 38, 1: PRINT "Move mouse over a word to find."
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1) 'wait for a word to be clicked
    mx = INT(_MOUSEX / 8) + 1: my = INT(_MOUSEY / 16) + 1
    IF mx >= 65 AND mx <= 84 THEN
        mIndex = my
    ELSEIF mx >= 85 AND mx <= 104 THEN
        mIndex = my + 40
    ELSEIF mx >= 105 AND mx <= 125 THEN
        mIndex = my + 80
    ELSE
        mIndex = 0
    END IF
    wIndex = 0: cnt = 0 '                 convert mIndex to wIndex of BestWords
    FOR i = 1 TO WS.NumWords
        IF BestWords(i).Placed THEN
            cnt = cnt + 1
            IF cnt = mIndex THEN wIndex = i: EXIT FOR
        END IF
    NEXT
    IF wIndex THEN
        IF Found(BestWords(wIndex).S, hx, hy, wd) THEN 'high lite it black, yellow
            ConvertCR2Screen hx, hy, sx, sy '    tranlate array location to screen location and navigate column, row
            ConvertCR2Nav hx, hy, wd, navX$, navY$, navD$
            LOCATE 38, 1: PRINT BestWords(wIndex).S; " found at ("; navX$; ", "; navY$; ") going "; navD$
            COLOR &HFF0000BB, &HFFFFFF00
            LOCATE sy, sx: PRINT CHR$(AscBestLetters(hx, hy));
            FOR i = 2 TO BestWords(wIndex).Len
                hx = hx + DX(wd): hy = hy + DY(wd)
                ConvertCR2Screen hx, hy, sx, sy
                LOCATE sy, sx: PRINT CHR$(AscBestLetters(hx, hy));
            NEXT
            COLOR &HFFFFFFFF, &HFF000000
        ELSE
            LOCATE 38, 1: PRINT "Sorry, something is screwed up!";
        END IF
    END IF
    _DISPLAY
    _LIMIT 60
WEND
 
SUB InitializeOnce ' everything that needs to be done once to get going
    REDIM wd$, i, j, fName$, pLine$
 
    'new order to favor diagonals placements first if possible
    DX(0) = 1: DY(0) = 0: DString$(0) = "East"
    DX(1) = 0: DY(1) = 1: DString$(1) = "South"
    DX(2) = -1: DY(2) = 0: DString$(2) = "West"
    DX(3) = 0: DY(3) = -1: DString$(3) = "North"
    DX(4) = -1: DY(4) = 1: DString$(4) = "South West"
    DX(5) = -1: DY(5) = -1: DString$(5) = "North West"
    DX(6) = 1: DY(6) = 1: DString$(6) = "South East"
    DX(7) = 1: DY(7) = -1: DString$(7) = "North East"
 
    WS.GridSideM1 = WS.GridSide - 1
    WS.GridSideP2M1 = WS.GridSide * WS.GridSide - 1
    WS.GridLabel = MID$("   0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z", 1, WS.GridSide * 2 + 2)
 
    WS.NumWords = 0
    WHILE wd$ <> "YULETIDE"
        READ wd$
        wd$ = _TRIM$(UCASE$(wd$))
        IF LEN(wd$) <= WordLengthLimit AND wd$ <> "" THEN
            WS.NumWords = WS.NumWords + 1
            Words(WS.NumWords).S = wd$
        END IF
    WEND
    Sort Words()
    FOR j = 1 TO WS.NumWords
        FOR i = 1 TO LEN(Words(j).S)
            Words(j).Len = LEN(Words(j).S)
            AscWord(j, i) = ASC(Words(j).S, i)
        NEXT
    NEXT
 
    REDIM AscLetters(0 TO WS.GridSideM1, 0 TO WS.GridSideM1) 'now that we have the right size
 
    'Now make a Sorted Word List file of up to 3 Columns of 40 words from the capitalized, trimmed, sorted word list
    fName$ = WS.FileTheme + " Sorted 3 Column Search Words.txt"
    OPEN fName$ FOR OUTPUT AS #1
    FOR i = 1 TO 40
        pLine$ = SPACE$(60)
        IF i <= WS.NumWords THEN MID$(pLine$, 1, 20) = TS$(i) + ") " + Words(i).S
        IF i + 40 <= WS.NumWords THEN MID$(pLine$, 21, 20) = TS$(i + 40) + ") " + Words(i + 40).S
        IF i + 80 <= WS.NumWords THEN MID$(pLine$, 41, 20) = TS$(i + 80) + ") " + Words(i + 80).S
        PRINT #1, pLine$
    NEXT
    CLOSE #1
    EXIT SUB
 
    DATA baby,bethlehem,cards,carols,coal,cookies,december,decorate,eggnog,elf,eve,festivities,garland,gifts,green
    DATA grinch,holiday,holly,joseph,joy,lights,mary,magi,manger,nativity,ornaments,poinsettia,red,reindeer,rudolph
    DATA santa,scrooge,shepherd,sleigh,star,stockings,tidings,tinsel,tree,toys,wreath,mistletoe,candycane,angel
    DATA chimney,fruitcake,gingerbread,greetings,goodwill,jingle,jolly,noel,naughty,nice,party
    DATA partridge,ribbon,bow,helpers,sweater,wrap,vacation,workshop,yuletide
END SUB
 
SUB RestartPuzzleFill
    DIM i, j, k, r, c
 
    WS.PlaceWordIndex = 0
    WS.NumUnplacedWords = 0 'count the disasters
    WS.NumPlacedWords = 0
    FOR i = 1 TO WS.NumWords 'clear positions of words
        Words(i).Placed = 0: Words(i).X = -1: Words(i).Y = -1: Words(i).D = -1
    NEXT
    FOR r = 0 TO WS.GridSideM1 ' clear the letter numbers
        FOR c = 0 TO WS.GridSideM1
            AscLetters(c, r) = 32
        NEXT
    NEXT
    FOR i = WS.NumWords TO 2 STEP -1 'shuffle the list of Words to load
        r = INT(RND * i) + 1
        SWAP Words(i), Words(r)
        FOR j = 0 TO WordLengthLimit
            SWAP AscWord(i, j), AscWord(r, j)
        NEXT
    NEXT
    i = 0
    WHILE i < WS.NumWords - 1 'order by word length
        i = i + 1
        FOR j = i + 1 TO WS.NumWords
            IF Words(j).Len > Words(i).Len THEN
                SWAP Words(i), Words(j)
                FOR k = 0 TO WordLengthLimit
                    SWAP AscWord(i, k), AscWord(j, k)
                NEXT
            END IF
        NEXT
    WEND
END SUB
 
SUB ShowPuzzle 'this was needed to make sure finding the best puzzle was working correctly
    DIM i, x, y, cnt, notPlaced$, cntUnplaced
    notPlaced$ = ""
    CLS
    LOCATE 1, 1: PRINT WS.GridLabel$
    FOR i = 3 TO 2 + WS.GridSide
        LOCATE i, 1: PRINT MID$(WS.GridLabel$, i * 2 - 2, 1);
    NEXT
    FOR y = 0 TO WS.GridSide - 1
        FOR x = 0 TO WS.GridSide - 1
            LOCATE y + 3, 2 * x + 4: PRINT CHR$(AscLetters(x, y))
        NEXT
    NEXT
    FOR i = 1 TO WS.PlaceWordIndex
        IF Words(i).Placed THEN
            cnt = cnt + 1
            IF cnt <= 40 THEN
                LOCATE cnt, 65: PRINT TS$(cnt); " "; Words(i).S;
            ELSEIF cnt <= 80 THEN
                LOCATE cnt - 40, 85: PRINT TS$(cnt); " "; Words(i).S;
            ELSEIF i <= 120 THEN
                LOCATE cnt - 80, 105: PRINT TS$(cnt); " "; Words(i).S;
            END IF
        ELSE
            cntUnplaced = cntUnplaced + 1
            notPlaced$ = notPlaced$ + Words(i).S + " "
        END IF
    NEXT
    LOCATE 36, 1: PRINT "Words placed:"; WS.NumPlacedWords
    LOCATE 37, 1: PRINT "Unplaced: "; WS.NumUnplacedWords
    LOCATE 38, 1: PRINT "Not placed words: "; notPlaced$; cntUnplaced
    LOCATE 39, 1: PRINT "Last word: "; TS$(WS.PlaceWordIndex); " "; Words(WS.PlaceWordIndex).S;
    'SLEEP
END SUB
 
SUB PlaceWord
    DIM bestScore, headScore, tailScore, y, x, d, b1, b2, i, spaceHeadF, spaceTailF
 
    bestScore = -1 ' going through entire array of AscLetters try every direction looking for best score = placement
    FOR y = 0 TO WS.GridSideM1
        FOR x = 0 TO WS.GridSideM1
            spaceHeadF = 0 'every new word do this must be certain we have at least one cell empty
            IF AscWord(WS.PlaceWordIndex, 1) = AscLetters(x, y) OR AscLetters(x, y) = 32 THEN
                IF AscWord(WS.PlaceWordIndex, 1) = AscLetters(x, y) THEN headScore = 15
                IF AscLetters(x, y) = 32 THEN headScore = 0: WS.UnfilledCellF = -1: spaceHeadF = -1 'no points for blanks but may proceed
                FOR d = 0 TO 7
                    spaceTailF = 0: tailScore = 0
                    b1 = x + DX(d) * (Words(WS.PlaceWordIndex).Len - 1) >= 0 AND x + DX(d) * (Words(WS.PlaceWordIndex).Len - 1) <= WS.GridSideM1
                    b2 = y + DY(d) * (Words(WS.PlaceWordIndex).Len - 1) >= 0 AND y + DY(d) * (Words(WS.PlaceWordIndex).Len - 1) <= WS.GridSideM1
                    IF b1 AND b2 THEN 'we're in
                        FOR i = 2 TO Words(WS.PlaceWordIndex).Len
                            IF AscWord(WS.PlaceWordIndex, i) = AscLetters(x + DX(d) * (i - 1), y + DY(d) * (i - 1)) THEN
                                tailScore = tailScore + 10 + (d <= 3) * -1 + (d > 3) * -(INT(RND * 4) + 1)
                            ELSEIF AscLetters(x + DX(d) * (i - 1), y + DY(d) * (i - 1)) = 32 THEN
                                WS.UnfilledCellF = -1
                                spaceTailF = -1
                                tailScore = tailScore + (d > 1) * -1 + (d > 3) * -1 + (d > 6) * -.5
                            ELSE
                                GOTO skip
                            END IF
                        NEXT
                        IF headScore + tailScore > bestScore AND (spaceHeadF OR spaceTailF) THEN 'make sure placing word over at least one empty spot
                            Words(WS.PlaceWordIndex).X = x: Words(WS.PlaceWordIndex).Y = y: Words(WS.PlaceWordIndex).D = d
                            bestScore = headScore + tailScore 'local
                        END IF
                    END IF
                    skip:
                NEXT
            END IF
        NEXT
    NEXT
    'BEEP
    IF bestScore > -1 THEN 'we have a good place for this word put it there and update stuff
        FOR i = 1 TO Words(WS.PlaceWordIndex).Len
            AscLetters(DX(Words(WS.PlaceWordIndex).D) * (i - 1) + Words(WS.PlaceWordIndex).X,_
             DY(Words(WS.PlaceWordIndex).D) * (i - 1) + Words(WS.PlaceWordIndex).Y) = ascWord(WS.PlaceWordIndex, i)
        NEXT
        Words(WS.PlaceWordIndex).Placed = -1
        WS.NumPlacedWords = WS.NumPlacedWords + 1
    ELSE
        Words(WS.PlaceWordIndex).Placed = 0
        WS.NumUnplacedWords = WS.NumUnplacedWords + 1
    END IF
END SUB
 
SUB ShowBestPuzzle
    REDIM mMod, m, i, j, x, y, DirectionTotals(0 TO 7), s$(1 TO 4)
 
    mMod = LEN(WS.Filler) '     FillBlanksInBest
    FOR y = 0 TO WS.GridSide - 1
        FOR x = 0 TO WS.GridSide - 1
            IF AscBestLetters(x, y) = 32 THEN
                AscBestLetters(x, y) = ASC(WS.Filler, m + 1)
                m = (m + 1) MOD mMod
            END IF
        NEXT
    NEXT
 
    CLS '                                redraw screen
    LOCATE 1, 1: PRINT WS.GridLabel$
    FOR i = 3 TO 2 + WS.GridSide
        LOCATE i, 1: PRINT MID$(WS.GridLabel$, i * 2 - 2, 1);
    NEXT
    FOR y = 0 TO WS.GridSide - 1
        FOR x = 0 TO WS.GridSide - 1
            LOCATE y + 3, 2 * x + 4: PRINT CHR$(AscBestLetters(x, y))
        NEXT
    NEXT
 
    FOR i = 1 TO WS.NumWords
        IF BestWords(i).Placed THEN
            j = j + 1
            IF j <= 40 THEN
                LOCATE j, 65: PRINT TS$(j); " "; BestWords(i).S;
            ELSEIF j <= 80 THEN
                LOCATE j - 40, 85: PRINT TS$(j); " "; BestWords(i).S;
            ELSEIF j <= 120 THEN
                LOCATE j - 80, 105: PRINT TS$(j); " "; BestWords(i).S
            END IF
            DirectionTotals(BestWords(i).D) = DirectionTotals(BestWords(i).D) + 1
        END IF
    NEXT
    s$(1) = " Total Norths: " + TS$(DirectionTotals(3)) + ", Total Souths: " + TS$(DirectionTotals(1))
    s$(2) = " Total Easts: " + TS$(DirectionTotals(0)) + ", Total Wests: " + TS$(DirectionTotals(2))
    s$(3) = " Total NWs: " + TS$(DirectionTotals(5)) + ", Total SWs: " + TS$(DirectionTotals(4))
    s$(4) = " Total NEs: " + TS$(DirectionTotals(7)) + ", Total SEs: " + TS$(DirectionTotals(6))
    FOR i = 1 TO 4
        LOCATE 32 + i, 1: PRINT s$(i);
    NEXT
END SUB
 
SUB FilePuzzle
    REDIM i, j, r, c, b$, x$, y$, d$, s$(1 TO 4)
 
    OPEN WS.FileTheme + " Word Search Puzzle.txt" FOR OUTPUT AS #1
    PRINT #1, WS.GridLabel$
    PRINT #1, ""
    FOR r = 0 TO WS.GridSideM1
        b$ = MID$(WS.GridLabel$, r * 2 + 4, 1) + "  "
        FOR c = 0 TO WS.GridSideM1
            b$ = b$ + CHR$(AscBestLetters(c, r)) + " "
        NEXT
        PRINT #1, b$
    NEXT
    CLOSE #1
 
    OPEN WS.FileTheme + " Word Search Solutions.txt" FOR OUTPUT AS #1
    PRINT #1, ""
    PRINT #1, " Search Word Solutions:"
    PRINT #1, "            Words from: " + WS.FileTheme + " Word List.txt"
    PRINT #1, ""
    PRINT #1, " First Letter Location and Direction:"
    PRINT #1, ""
    FOR i = 1 TO WS.NumWords
        IF BestWords(i).Placed THEN
            j = j + 1
            ConvertCR2Nav BestWords(i).X, BestWords(i).Y, BestWords(i).D, x$, y$, d$
            PRINT #1, RIGHT$("    " + TS$(j), 4) + ") " + RIGHT$(SPC(15) + BestWords(i).S, 15) + " (" + x$ + ", " + y$ + ") >>>---> " + d$
        END IF
    NEXT
    PRINT #1, " "
    s$(1) = " Total Norths: " + TS$(DirectionTotals(3)) + ", Total Souths: " + TS$(DirectionTotals(1))
    s$(2) = " Total Easts: " + TS$(DirectionTotals(0)) + ", Total Wests: " + TS$(DirectionTotals(2))
    s$(3) = " Total NWs: " + TS$(DirectionTotals(5)) + ", Total SWs: " + TS$(DirectionTotals(4))
    s$(4) = " Total NEs: " + TS$(DirectionTotals(7)) + ", Total SEs: " + TS$(DirectionTotals(6))
    FOR i = 1 TO 4
        PRINT #1, s$(i)
    NEXT
    PRINT #1, " "
    PRINT #1, " Message in unused letters: " + WS.Filler
    CLOSE #1
END SUB
 
FUNCTION Found (word$, headX, headY, direction)
    'First find a letter that matches the first letter in word$,
    'then at that x, y try each of 8 directions to see if find a match.
    'See if enough room to fit the find word before heading out to match letters.
 
    DIM first$, lenFind, x, y, d, b1, b2, xx, yy, b$, i
 
    first$ = MID$(word$, 1, 1): lenFind = LEN(word$) - 1
    FOR y = 0 TO WS.GridSideM1
        FOR x = 0 TO WS.GridSideM1
            IF AscBestLetters(x, y) = ASC(first$) THEN
                FOR d = 0 TO 7 'will word fit in this direction? 2 booleans True condition
                    b1 = lenFind * DX(d) + x >= 0 AND lenFind * DX(d) + x <= WS.GridSideM1
                    b2 = lenFind * DY(d) + y >= 0 AND lenFind * DY(d) + y <= WS.GridSideM1
                    IF b1 AND b2 THEN 'word fits,
                        ' build word from Letters block to see if matches word to find
                        b$ = first$: xx = x + DX(d): yy = y + DY(d)
                        FOR i = 2 TO LEN(word$)
                            b$ = b$ + CHR$(AscBestLetters(xx, yy))
                            xx = xx + DX(d): yy = yy + DY(d)
                        NEXT
                        xx = x: yy = y 'copy x, y for rebuilding word on screen
                        IF b$ = word$ THEN 'found one show our result
                            headX = x: headY = y: direction = d: Found = -1
                            EXIT SUB
                        END IF
                    END IF
                NEXT
            END IF
        NEXT
    NEXT
END FUNCTION
 
SUB ConvertCR2Screen (c, r, screenC, screenR)
    screenC = 2 * c + 4: screenR = r + 3
END SUB
 
SUB ConvertCR2Nav (c, r, d, navX$, navY$, navD$)
    IF c > 9 THEN navX$ = CHR$(c - 9 + AscA - 1) ELSE navX$ = TS$(c)
    IF r > 9 THEN navY$ = CHR$(r - 9 + AscA - 1) ELSE navY$ = TS$(r)
    navD$ = DString$(d)
END SUB
 
SUB Sort (arr() AS WordType)
    DIM i, j
    FOR i = 1 TO WS.NumWords - 1
        FOR j = i + 1 TO WS.NumWords
            IF arr(j).S < arr(i).S THEN SWAP arr(j), arr(i)
        NEXT
    NEXT
END SUB
 
FUNCTION TS$ (n) ' this shorthand for TrimString and I want it shorthand!
    TS$ = _TRIM$(STR$(n))
END FUNCTION
 
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 08, 2020, 11:26:42 pm

Cool pine trees B+! Good job!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 09, 2020, 02:13:47 am

Here is my Christmas Tree ornament. It's not as fancy as B+'s, but I thought I would throw this in tonight. Feel free to use any of the code for your own. Below is a picture. The program itself changes the colors of the parallel circles (ovals).

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 600, 32)
_TITLE "SierraKen's Christmas Tree Ornament - Press Esc to quit."
RANDOMIZE TIMER
c3 = 255
FOR cir = .01 TO 130 STEP .1
    c3 = c3 - .1
    CIRCLE (400, 300), cir, _RGB32(0, 0, c3)
NEXT cir
DO
    _LIMIT 30
    yy = 300
    c4 = INT(RND * 155) + 100
    c5 = INT(RND * 155) + 100
    c6 = INT(RND * 155) + 100
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), , , .5
    yy = yy - 22.5
    CIRCLE (400, yy), 125, _RGB32(c4, c5, c6), , , .5
    yy = yy - 22.5
    CIRCLE (400, yy), 120, _RGB32(c4, c5, c6), , , .5
    yy = yy - 22.5
    CIRCLE (400, yy), 105, _RGB32(c4, c5, c6), , , .5
    yy = yy - 22.5
    CIRCLE (400, yy), 75, _RGB32(c4, c5, c6), , , .5
    yy = yy - 22.5
    CIRCLE (400, yy), 15, _RGB32(c4, c5, c6), , , .5
    yy = 300
    yy = yy + 22.5
    CIRCLE (400, yy), 125, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 120, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 105, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 75, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 15, _RGB32(c4, c5, c6), , , .5
    _DELAY .5
LOOP UNTIL INKEY$ = CHR$(27)
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 09, 2020, 01:02:58 pm

Thanks Ken, only one gasp in awe ;-))

Ken I just noticed your ornament, I can't tell which side is toward me top or bottom? When I look at top then that side, when I look at bottom, that side, I love it and with different lights too.

I wonder if we could make it flip: It goes from light to dark, dark to light then flips...
You'd draw half circles one way (except at top you can see whole cicle and at bottom no circle, then the other half circles the other way.

Well on 2nd thought, it's harder than that because it's more or less than half circles.
Maybe _vince or STx can figure it out, Ashish can probably draw it wobbling like the Earth in it's orbits with GL stuff.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: johnno56 on December 09, 2020, 02:44:07 pm

Bplus,

Possible answer for "which side".

As you know, all surface points are equidistant from its centre. So technically, a sphere, has no "sides". Unless it is hollow... Inside and outside...

To answer your query, 'which side is toward me', for want of a better word, the 'outside' is toward you....

But, you have to admit, it's a very nice blue.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 09, 2020, 02:55:58 pm

Thanks guys :). Yeah the only way to explain it would be that it's blue glass and you can see right through it. I also thought about half-circles but I came to the same conclusion, it wouldn't look right for all of them, unless I figured out the right shape on each of them... dang now I want to see if I can do it..... :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 09, 2020, 03:09:48 pm

I have also something in progress... i think this is done by 7 days or so... :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 09, 2020, 04:19:15 pm

Here we go. I did all the lines manually by trial and error and I added a glowing blue the pulsates. Now you can't see the other side and you can only see from about a 45 degree angle from the bottom (or 315 degrees if you want to be technical :)). This is a better Christmas Tree ornament than my last one.

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 600, 32)
_TITLE "SierraKen's Christmas Tree Ornament - Press Esc to quit."
DIM col AS SINGLE
DIM c3 AS SINGLE
DIM c4 AS SINGLE
DIM c5 AS SINGLE
DIM c6 AS SINGLE
DIM yy AS SINGLE
DIM t AS SINGLE
RANDOMIZE TIMER
t = 1
DO
    _LIMIT 60
    IF col > 100 THEN t = 0
    IF col < 50 THEN t = 1
    IF t = 0 THEN col = col - 25
    IF t = 1 THEN col = col + 25
    c3 = 255
    FOR cir = .01 TO 130 STEP .1
        c3 = c3 - .1
        CIRCLE (400, 300), cir, _RGB32(0, 0, c3 - col)
    NEXT cir
    yy = 300
    c4 = INT(RND * 155) + 100
    c5 = INT(RND * 155) + 100
    c6 = INT(RND * 155) + 100
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy - 40.5
    CIRCLE (400, yy), 124, _RGB32(c4, c5, c6), 2 * _PI, _PI, .4
    yy = yy - 30.5
    CIRCLE (400, yy), 105, _RGB32(c4, c5, c6), 2 * _PI, _PI, .39
    yy = 300
    yy = yy + 22.5
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 125, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 110, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 75, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 15, _RGB32(c4, c5, c6), , , .5
    _DELAY .25
    _DISPLAY
LOOP UNTIL INKEY$ = CHR$(27)
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 09, 2020, 05:22:27 pm

@SierraKen NICE! you did the hard work, now you can take snapshots at different light levels and play a round upside down and the next right side up AND/OR grab our old favorite RotoZoom and do...

oh heck! then you can do any size and at any place!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 09, 2020, 08:25:53 pm

Thanks B+. But from what I know, I couldn't copy it to other places without having a lot of black erase parts of them because the _COPYIMAGE (0) and ROTOZOOM turns the entire screen and not a part of it that I know of. I tried using the old GET command without luck. But I was able to make this one that just snaps a photo of it and then goes in a ROTOZOOM loop with it turning non-stop. :) It doesn't change colors but it looks really cool! Notice I put the ornament in its own SUB. :) It does have a random color on the lines though for each time you run the program. I like this one even more than the others. :)

Code: QB64: [Select]

_TITLE "SierraKen's Christmas Tree Ornament - Press Esc to quit."
DIM col AS SINGLE
DIM c3 AS SINGLE
DIM c4 AS SINGLE
DIM c5 AS SINGLE
DIM c6 AS SINGLE
DIM yy AS SINGLE
DIM t AS SINGLE
DIM x AS LONG, y AS LONG, Image AS LONG, Scale AS SINGLE, Rotation AS SINGLE
DIM i AS LONG
DIM orn AS LONG
RANDOMIZE TIMER
t = 1
i& = _NEWIMAGE(800, 600, 32)
SCREEN i&
ornament
orn = _COPYIMAGE(0)
CLS
DO
    _LIMIT 60
    RotoZoom 400, 300, orn&, 1, turn 'Angle
    _DELAY .01
    _DISPLAY
    CLS
    turn = turn + 1
LOOP UNTIL INKEY$ = CHR$(27)
 
SUB ornament
    c3 = 255
    FOR cir = .01 TO 130 STEP .1
        c3 = c3 - .1
        CIRCLE (400, 300), cir, _RGB32(0, 0, c3)
    NEXT cir
    yy = 300
    c4 = INT(RND * 155) + 100
    c5 = INT(RND * 155) + 100
    c6 = INT(RND * 155) + 100
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy - 40.5
    CIRCLE (400, yy), 124, _RGB32(c4, c5, c6), 2 * _PI, _PI, .4
    yy = yy - 30.5
    CIRCLE (400, yy), 105, _RGB32(c4, c5, c6), 2 * _PI, _PI, .39
    yy = 300
    yy = yy + 22.5
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 125, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 110, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 75, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 15, _RGB32(c4, c5, c6), , , .5
END SUB
 
 
 
SUB RotoZoom (X AS LONG, Y AS LONG, Image AS LONG, Scale 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 / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
    FOR i& = 0 TO 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
        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
 
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 09, 2020, 08:41:35 pm

@SierraKen Dang that's NICER! Rotating it, makes it more 3D IMHO.

With _PUTIMAGE, you can put snapshot anywhere you want, any size you want.

Making an ornament sub is really good then you can give ornament a center(x, y) coodinate and it will draw there instead of the center of the screen, same with color, same with radius (but the stuff you did by hand has to be in relation to the center of the screen = center (x, y) of ornament. Let me know if your head is starting to ache ;-))

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 09, 2020, 10:48:51 pm

LOL thanks B+, but I think that's all my brain can take for now. I might look into this more soon. :) I do agree that it looks more 3D :).

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 10, 2020, 01:15:51 am

Here's something:

Code: QB64: [Select]

_TITLE "b+ mod SierraKen's Ornament - Press Esc to quit." ' b+ 2020-12-09
CONST Xmax = 800, Ymax = 600, nOrn = 21, OrnR = 50
REDIM SHARED Orn AS LONG
SCREEN _NEWIMAGE(Xmax, Ymax, 32)
REDIM OrnX(1 TO nOrn), OrnY(1 TO nOrn), OrnA(1 TO nOrn)
 
' Get locations for a pyramid of circles st: ========================================================
'let n = number of circles at base of pile
n = 6
 
'let r = radius of each circle
r = OrnR
 
'let base be total length of pile
baseLength = 2 * r * n
 
'center pyramid in middle of screen
startx = (Xmax - baseLength) / 2
 
'stacking circles that form equilateral triangles at their origins have a height change of
deltaHeight = r * 3 ^ .5 'r times the sqr(3)
i = 1
FOR row = n TO 1 STEP -1
    IF row = n THEN y = Ymax - r - 1 ELSE y = y - deltaHeight
    FOR col = 1 TO row
        x = startx + col * 2 * r - r
        'CIRCLE (x, y), r
        OrnX(i) = x: OrnY(i) = y: OrnA(i) = RND * 360
        i = i + 1
    NEXT
    startx = startx + r
NEXT
' ======================================================================================================
 
ornament 'draw ornament and note the background is transparent at moment
 
_DELAY 1.5
Orn = _NEWIMAGE(262, 262, 32)
 
_PUTIMAGE , 0, Orn, (Xmax / 2 - 131, Ymax / 2 - 131)-STEP(262, 262)
CLS
DO
    FOR i = 1 TO nOrn
        OrnA(i) = OrnA(i) + 1
        drawOrn OrnX(i), OrnY(i), 50, OrnA(i)
    NEXT
    _DISPLAY
    _LIMIT 60
LOOP UNTIL INKEY$ = CHR$(27)
 
SUB drawOrn (x, y, r, degreeAngle)
    OffScrn = _NEWIMAGE(262, 262, 32)
    _DEST OffScrn
    RotoZoom 131, 131, Orn, 1, degreeAngle
    _PUTIMAGE (x - r, y - r)-STEP(2 * r, 2 * r), OffScrn, 0
    _DEST 0
    _FREEIMAGE OffScrn
END SUB
 
SUB ornament
    c3 = 180
    FOR cir = .01 TO 133 STEP .1
        c3 = c3 - .07
        CIRCLE (400, 300), cir, _RGB32(0, c3, 0)
    NEXT cir
    yy = 300
    CIRCLE (400, yy), 130, &HFFFFFFFF, 2 * _PI, _PI, .5
    yy = yy - 40.5
    CIRCLE (400, yy), 124, &HFFFFFFFF, 2 * _PI, _PI, .4
    yy = yy - 30.5
    CIRCLE (400, yy), 105, &HFFFFFFFF, 2 * _PI, _PI, .39
    yy = 300
    yy = yy + 22.5
    CIRCLE (400, yy), 130, &HFFFFFFFF, 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 125, &HFFFFFFFF, 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 110, &HFFFFFFFF, 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 75, &HFFFFFFFF, , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 15, &HFFFFFFFF, , , .5
END SUB
 
SUB RotoZoom (X AS LONG, Y AS LONG, Image AS LONG, Scale 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 / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
    FOR i& = 0 TO 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
        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
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 10, 2020, 01:49:24 am

I turned mine into a Musical Christmas Tree Ornament. It plays Jingle Bells while the ornament turns. The PLAY command plays notes in the background but you need to add "MB" at the start of the PLAY string, as you can see in my JingleBells SUB. I found the notes and lyrics online. The lyrics stay in time with the song as it plays and writes them in the _TITLE bar.

Code: QB64: [Select]

'Musical Christmas Tree Ornament - Sing to Jingle Bells with your computer!
'by SierraKen
'Music Notes and Lyrics found here: https://www.piano-keyboard-guide.com/how-to-play-jingle-bells-easy-piano-keyboard-tutorial-for-beginners/
 
DIM i AS LONG
DIM orn AS LONG
RANDOMIZE TIMER
t = 1
i& = _NEWIMAGE(800, 600, 32)
SCREEN i&
ornament
orn& = _COPYIMAGE(0)
CLS
JingleBells
READ song$: _TITLE song$
DO
    _LIMIT 60
    RotoZoom 400, 300, orn&, 1, turn 'Angle
    _DELAY .01
    _DISPLAY
    CLS
    a$ = INKEY$
    IF a$ = CHR$(27) THEN END
    IF e = 1 AND a$ = " " THEN RESTORE song: e = 0: CLS: turn = 0: READ song$: _TITLE song$: JingleBells
    turn = turn + 1
    IF turn / 145 = INT(turn / 145) AND e <> 1 THEN
        READ song$
        IF song$ = "done" THEN e = 1: GOTO skip:
        _TITLE song$
        skip:
        IF e = 1 THEN _TITLE "Musical Christmas Tree Ornament - Press Space Bar to play song again. - Press Esc to quit."
    END IF
LOOP
song:
DATA "Jingle bells, jingle bells."
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh hey"
DATA "Jingle bells, jingle bells"
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh"
DATA "Dashing through the snow"
DATA "On a one horse open sleigh"
DATA "O'er the fields we go,"
DATA "Laughing all the way"
DATA "Bells on bob tail ring,"
DATA "making spirits bright"
DATA "What fun it is to laugh and sing"
DATA "A sleighing song tonight, Oh"
DATA "Jingle bells, jingle bells"
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh hey"
DATA "Jingle bells, jingle bells"
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh"
DATA "done"
 
SUB JingleBells
    PLAY "MB L5 E E E E E E"
    PLAY "MB L5 E G C D E"
    PLAY "MB L5 F F F F F E E"
    PLAY "MB L5 E E E D D E D G"
    PLAY "MB L5 E E E E E E"
    PLAY "MB L5 E G C D E"
    PLAY "MB L5 F F F F F E E"
    PLAY "MB L5 E E G G F D C"
 
    PLAY "MB L5 G E D C G"
    PLAY "MB L5 G G G E D C A"
    PLAY "MB L5 A F E D B"
    PLAY "MB L5 A G F D E"
    PLAY "MB L5 G E D C G"
    PLAY "MB L5 G E D C A"
    PLAY "MB L5 A A F E D G G G"
    PLAY "MB L5 G A G F D C G"
 
    PLAY "MB L5 E E E E E E"
    PLAY "MB L5 E G C D E"
    PLAY "MB L5 F F F F F E E"
    PLAY "MB L5 E E E D D E D G"
    PLAY "MB L5 E E E E E E"
    PLAY "MB L5 E G C D E"
    PLAY "MB L5 F F F F F E E"
    PLAY "MB L5 E E G G F D C"
END SUB
 
 
SUB ornament
    c3 = 255
    FOR cir = .01 TO 130 STEP .1
        c3 = c3 - .1
        CIRCLE (400, 300), cir, _RGB32(0, 0, c3)
    NEXT cir
    yy = 300
    c4 = INT(RND * 155) + 100
    c5 = INT(RND * 155) + 100
    c6 = INT(RND * 155) + 100
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy - 40.5
    CIRCLE (400, yy), 124, _RGB32(c4, c5, c6), 2 * _PI, _PI, .4
    yy = yy - 30.5
    CIRCLE (400, yy), 105, _RGB32(c4, c5, c6), 2 * _PI, _PI, .39
    yy = 300
    yy = yy + 22.5
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 125, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 110, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 75, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 15, _RGB32(c4, c5, c6), , , .5
END SUB
 
 
 
SUB RotoZoom (X AS LONG, Y AS LONG, Image AS LONG, Scale 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 / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
    FOR i& = 0 TO 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
        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
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 10, 2020, 01:52:41 am

LOL That's awesome B+! I will have to study how you did that sometime. :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 10, 2020, 09:51:48 am

That's a great demo of PLAY Ken! I'll have to give that a try.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SMcNeill on December 10, 2020, 12:32:46 pm

If it's Christmas time, then it's all about time to go caroling, for which this little program might be of some help:

Code: QB64: [Select]

SCREEN _NEWIMAGE(1024, 720, 32)
 
 
REDIM songs(100) AS STRING
 
 
DO
    READ text$
    IF text$ = "EOD" THEN EXIT DO
    IF LEFT$(text$, 3) = "***" THEN count = count + 1: lines = 0
    IF lines > 40 THEN songs(count) = songs(count) + "  (CONTINUE)  ": lines = 0: count = count + 1
    lines = lines + 1
    songs(count) = songs(count) + text$ + CHR$(10)
LOOP
 
FOR i = 1 TO count
    CLS
    PRINT songs(i)
    SLEEP
NEXT
 
CLS
PRINT "Would you like to print these to a file, so you can print or view them elsewhere?"
DO: i$ = UCASE$(INPUT$(1)): LOOP UNTIL i$ = "Y" OR i$ = "N"
IF i$ = "Y" THEN
    INPUT "Give me a file name to save to: "; filename$
    IF filename$ = "" THEN filename$ = "Christmas Lyrics.txt"
    OPEN filename$ FOR OUTPUT AS #1
    RESTORE
    DO
        READ text$
        IF text$ = "EOD" THEN EXIT DO
        IF LEFT$(text$, 3) = "***" THEN PRINT #1, ""
        PRINT #1, text$
    LOOP
    CLOSE
END IF
 
SYSTEM
 
 
DATA "**** Angels We Have Heard On High ****"
DATA "Angels we have heard on high"
DATA "Sweetly singing over the plains"
DATA "And the mountains in reply,"
DATA "Echoing their joyous strains."
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "Shepherds, why this Jubilee?"
DATA "Why your joyous strains prolong?"
DATA "What the gladsome tidings be"
DATA "Which inspire your heavenly song?"
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "Come to Bethlehem and see"
DATA "Him whose birth the angels sing;"
DATA "Come, adore on bended knee"
DATA "Christ, the Lord,"
DATA "the newborn King"
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "See Him in a manger laid"
DATA "Jesus, Lord of heaven and earth!"
DATA "Mary, Joseph, lend your aid,"
DATA "With us sing our Savior's birth."
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "Glo-ori-a"
DATA "In excelsis de-o"
DATA "**** Away In a Manger ****"
DATA "Away in a manger,"
DATA "no crib for His bed,"
DATA "The little Lord Jesus"
DATA "laid down His sweet head;"
DATA "The stars in the heavens"
DATA "looked down where He lay,"
DATA "The little Lord Jesus"
DATA "asleep on the hay."
DATA "The cattle are lowing,"
DATA "the poor Baby wakes,"
DATA "But little Lord Jesus,"
DATA "no crying He makes."
DATA "I love Thee, Lord Jesus;"
DATA "look down from the sky"
DATA "And stay by my cradle"
DATA "till morning is nigh."
DATA "Be near me, Lord Jesus;"
DATA "I ask Thee to stay"
DATA "Close by me forever"
DATA "and love me I pray!"
DATA "Bless all the dear children"
DATA "in Thy tender care,"
DATA "And fit us for Heaven"
DATA "to live with Thee there."
DATA "Away in a manger,"
DATA "no crib for His bed,"
DATA "The little Lord Jesus"
DATA "laid down His sweet head;"
DATA "The stars in the heavens"
DATA "looked down where He lay,"
DATA "The little Lord Jesus"
DATA "asleep on the hay."
DATA "**** Deck The Halls ****"
DATA "Deck the halls with boughs of holly"
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "'Tis the season to be jolly"
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "Don we now our gay apparel"
DATA " Fa-la-la, la-la-la, la-la-la."
DATA "Troll the ancient Yule-tide carol"
DATA " Fa-la-la-la-la, la-la-la-la."
DATA "See the blazing Yule before us."
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "Strike the harp and join the chorus."
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "Follow me in merry measure."
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "While I tell of Yule-tide treasure."
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "Fast away the old year passes."
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "Hail the new year, lads and lasses"
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "Sing we joyous, all together."
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "heedless of the wind and weather."
DATA " Fa-la-la-la-la, la-la-la-la"
DATA "**** Do You Hear What I Hear ****"
DATA "Said the night wind to the little lamb,"
DATA "do you see what I see"
DATA "Way up in the sky, little lamb,"
DATA "do you see what I see"
DATA "A star, a star, dancing in the night"
DATA "With a tail as big as a kite"
DATA "With a tail as big as a kite"
DATA "Said the little lamb to the shepherd boy,"
DATA "do you hear what I hear"
DATA "Ringing through the sky, shepherd boy,"
DATA "do you hear what I hear"
DATA "A song, a song, high above the trees"
DATA "With a voice as big as the sea"
DATA "With a voice as big as the sea"
DATA "Said the shepherd boy to the mighty king,"
DATA "do you know what I know"
DATA "In your palace warm, mighty king,"
DATA "do you know what I know"
DATA "A Child, a Child shivers in the cold"
DATA "Let us bring Him silver and gold"
DATA "Let us bring Him silver and gold"
DATA "Said the king to the people everywhere,"
DATA "listen to what I say"
DATA "Pray for peace, people everywhere!"
DATA "listen to what I say"
DATA "The Child, the Child, sleeping in the night"
DATA "He will bring us goodness and light"
DATA "He will bring us goodness and light"
DATA "**** Far, Far Away on Judea's Plains ****"
DATA "Far, far away on Judea's plains,"
DATA "Shepherds of old"
DATA "heard the joyous strains:"
DATA "Glory to God, Glory to God,"
DATA "Glory to God in the highest:"
DATA "Peace on earth,"
DATA "good-will to men;"
DATA "Peace on earth,"
DATA "good-will to men!"
DATA "Sweet are these strains"
DATA "of redeeming love,"
DATA "Message of mercy from heaven above:"
DATA "Glory to God, Glory to God,"
DATA "Glory to God in the highest:"
DATA "Peace on earth,"
DATA "good-will to men;"
DATA "Peace on earth,"
DATA "Lord, with the angels"
DATA "we too would rejoice,"
DATA "Help us to sing with"
DATA "the heart and voice:"
DATA "Glory to God, Glory to God,"
DATA "Glory to God in the highest:"
DATA "Peace on earth,"
DATA "good-will to men;"
DATA "Peace on earth,"
DATA "good-will to men!"
DATA "Hasten the time when,"
DATA "from every clime,"
DATA "Men shall unite"
DATA "in the strains sublime:"
DATA "Glory to God, Glory to God,"
DATA "Glory to God in the highest:"
DATA "Peace on earth,"
DATA "good-will to men;"
DATA "Peace on earth,"
DATA "good-will to men!"
DATA "**** Frosty the Snow Man ****"
DATA "Frosty the snowman was a jolly happy soul,"
DATA "With a corncob pipe and a button nose"
DATA "and two eyes made out of coal."
DATA "Frosty the snowman is a fairy tale, they say,"
DATA "He was made of snow but the children"
DATA "know how he came to life one day."
DATA "There must have been some magic in that"
DATA "old silk hat they found."
DATA "For when they placed it on his head"
DATA "he began to dance around."
DATA "O, Frosty the snowman"
DATA "was alive as he could be,"
DATA "And the children say he could laugh"
DATA "and play just the same as you and me."
DATA "Thumpetty thump thump,"
DATA "thumpety thump thump,"
DATA "Look at Frosty go."
DATA "Thumpetty thump thump,"
DATA "thumpety thump thump,"
DATA "Over the hills of snow."
DATA "Frosty the snowman knew"
DATA "the sun was hot that day,"
DATA "So he said, 'Let's run and"
DATA "we'll have some fun"
DATA "now before I melt away.'"
DATA "Down to the village,"
DATA "with a broomstick in his hand,"
DATA "Running here and there all"
DATA "around the square saying,"
DATA "Catch me if you can."
DATA "He led them down the streets of town"
DATA "right to the traffic cop."
DATA "And he only paused a moment when"
DATA "he heard him holler 'Stop!'"
DATA "For Frosty the snow man"
DATA "had to hurry on his way,"
DATA "But he waved goodbye saying,"
DATA "'Don't you cry,"
DATA "I'll be back again some day.'"
DATA "Thumpetty thump thump,"
DATA "thumpety thump thump,"
DATA "Look at Frosty go."
DATA "Thumpetty thump thump,"
DATA "thumpety thump thump,"
DATA "Over the hills of snow."
DATA "**** Go, Tell It On The Mountain ****"
DATA "While shepherds kept their watching"
DATA "Over silent flocks by night,"
DATA "Behold throughout the heavens,"
DATA "There shone a holy light:"
DATA "Go, Tell It On The Mountain,"
DATA "Over the hills and everywhere;"
DATA "Go, Tell It On The Mountain"
DATA "That Jesus Christ is born."
DATA "The shepherds feared and trembled"
DATA "When lo! above the earth"
DATA "Rang out the angel chorus"
DATA "That hailed our Saviour's birth:"
DATA "Go, Tell It On The Mountain,"
DATA "Over the hills and everywhere;"
DATA "Go, Tell It On The Mountain"
DATA "That Jesus Christ is born."
DATA "Down in a lowly manger"
DATA "Our humble Christ was born"
DATA "And God send us salvation,"
DATA "That blessed Christmas morn:"
DATA "Go, Tell It On The Mountain,"
DATA "Over the hills and everywhere;"
DATA "Go, Tell It On The Mountain"
DATA "That Jesus Christ is born."
DATA "When I am a seeker,"
DATA "I seek both night and day;"
DATA "I seek the Lord to help me,"
DATA "And He shows me the way:"
DATA "Go, Tell It On The Mountain,"
DATA "Over the hills and everywhere;"
DATA "Go, Tell It On The Mountain"
DATA "That Jesus Christ is born."
DATA "He made me a watchman"
DATA "Upon the city wall,"
DATA "And if I am a Christian,"
DATA "I am the least of all."
DATA "Go, Tell It On The Mountain,"
DATA "Over the hills and everywhere;"
DATA "Go, Tell It On The Mountain"
DATA "That Jesus Christ is born."
DATA "**** God Rest Ye Merry, Gentlemen ****"
DATA "God Rest Ye Merry, Gentlemen,"
DATA "Let nothing you dismay;"
DATA "Remember Christ, our Saviour,"
DATA "Was born on Christmas day,"
DATA "To save us all from Satan's power"
DATA "When we were gone astray."
DATA "O tidings of comfort and joy,"
DATA "comfort and joy,"
DATA "O tidings of comfort and joy."
DATA "In Bethlehem, in Jewry,"
DATA "This blessed Babe was born,"
DATA "And laid within a manger,"
DATA "Upon this blessed morn;"
DATA "That which His Mother Mary,"
DATA "Did nothing take in scorn."
DATA "O tidings of comfort and joy,"
DATA "comfort and joy,"
DATA "O tidings of comfort and joy."
DATA "From God our Heavenly Father,"
DATA "A blessed Angel came;"
DATA "And unto certain Shepherds"
DATA "Brought tidings of the same:"
DATA "How that in Bethlehem was born"
DATA "The Son of God by Name."
DATA "O tidings of comfort and joy,"
DATA "comfort and joy,"
DATA "O tidings of comfort and joy."
DATA "'Fear not,' then said the Angel,"
DATA "'let nothing you affright,"
DATA "This day is born a Saviour"
DATA "Of pure Virgin bright,"
DATA "To free all those who trust in Him"
DATA "From Satan's power and might.'"
DATA "O tidings of comfort and joy,"
DATA "comfort and joy,"
DATA "O tidings of comfort and joy."
DATA "The shepherds at those tidings"
DATA "Rejoiced much in mind,"
DATA "And left their flocks a-feeding,"
DATA "In tempest, storm, and wind:"
DATA "And went to Bethlehem straightway,"
DATA "The Son of God to find."
DATA "O tidings of comfort and joy,"
DATA "comfort and joy,"
DATA "O tidings of comfort and joy."
DATA "And when they came to Bethlehem"
DATA "Where our dear Saviour lay,"
DATA "They found Him in a manger,"
DATA "Where oxen feed on hay;"
DATA "His Mother Mary kneeling down,"
DATA "Unto the Lord did pray."
DATA "O tidings of comfort and joy,"
DATA "comfort and joy,"
DATA "O tidings of comfort and joy."
DATA "Now to the Lord sing praises,"
DATA "All you within this place,"
DATA "And with true love and brotherhood"
DATA "Each other now embrace;"
DATA "This holy tide of Christmas"
DATA "All other doth deface."
DATA "O tidings of comfort and joy,"
DATA "comfort and joy,"
DATA "O tidings of comfort and joy."
DATA "**** Hark! The Herald Angels Sing ****"
DATA "Hark! the herald angels sing"
DATA "'Glory to the newborn King"
DATA "Peace on earth and mercy mild,"
DATA "God and sinners reconciled!'"
DATA "Joyful, all ye nations rise;"
DATA "Join the triumph of the skies;"
DATA "With angelic host proclaim"
DATA "'Christ is born in Bethlehem!'"
DATA "Hark! the herald angels sing"
DATA "'Glory to the newborn King!'"
DATA "Christ, by highest heaven adored;"
DATA "Christ the everlasting Lord;"
DATA "Late in time behold Him come,"
DATA "Offspring of the favored one."
DATA "Veiled in flesh, the Godhead see;"
DATA "hail the incarnate Deity"
DATA "Pleased as man with men to dwell,"
DATA "Jesus, our Emmanuel"
DATA "Hark! the herald angels sing,"
DATA "'Glory to the newborn King'"
DATA "Hail! the heaven-born Prince of Peace!"
DATA "Hail! the Son of Righteousness!"
DATA "Light and life to all He brings,"
DATA "risen with healing in His wings."
DATA "Mild He lays His glory by,"
DATA "born that man no more may die;"
DATA "Born to raise the sons of earth,"
DATA "born to give them second birth"
DATA "Hark! the herald angels sing,"
DATA "'Glory to the newborn King'"
DATA "**** I Heard the Bells on Christmas Day ****"
DATA "I Heard the Bells on Christmas Day"
DATA "Their old familiar carols play,"
DATA "And wild and sweet the words repeat"
DATA "Of peace on earth, good will to men."
DATA "I thought how, as the day had come,"
DATA "The belfries of all Christendom"
DATA "Had rolled along the unbroken song"
DATA "Of peace on earth, good will to men."
DATA "And in despair I bowed my head:"
DATA "'There is no peace on earth,' I said,"
DATA "'For hate is strong and mocks the song"
DATA "Of peace on earth, good will to men.'"
DATA "Then pealed the bells more loud and deep:"
DATA "'God is not dead, nor doth he sleep;"
DATA "The wrong shall fail, the right prevail,"
DATA "With peace on earth, good will to men.'"
DATA "Till, ringing singing, on its way,"
DATA "The world revolved from night to day,"
DATA "A voice, a chime, a chant sublime,"
DATA "Of peace on earth, good will to men!"
DATA "**** It Came Upon The Midnight Clear ****"
DATA "It came upon the midnight clear,"
DATA "That glorious song of old,"
DATA "From angels bending near the earth"
DATA "With news of joy foretold,"
DATA "'Peace on the earth, good will to men"
DATA "From heaven's all gracious King.'"
DATA "The world in solemn stillness lay,"
DATA "To hear the angels sing."
DATA "Still through the cloven skies they come,"
DATA "Love's banner all unfurled;"
DATA "And still their heavenly music floats"
DATA "Over all the weary world."
DATA "Above its sad and lowly plains"
DATA "Old echoes plaintive ring,"
DATA "And ever over its Babel sounds"
DATA "The blessed angels sing."
DATA "Yet with the woes of sin and strife"
DATA "The world has suffered long;"
DATA "Beneath the Angel-strain have rolled"
DATA "Two thousand years of wrong;"
DATA "And man at war with man hears not"
DATA "The love-song which they bring;"
DATA "O! hush the noise, ye men of strife,"
DATA "And hear the Angels sing."
DATA "O ye, beneath life's crushing load"
DATA "Whose forms are bending low,"
DATA "Who toil along the climbing way"
DATA "With painful steps and slow;"
DATA "Look now! for glad and golden hours"
DATA "Come swiftly on the wing;"
DATA "O rest beside the weary road"
DATA "And hear the angels sing."
DATA "For lo! the days are hastening on,"
DATA "By prophets seen of old,"
DATA "When with the ever-circling years"
DATA "Shall come the time foretold,"
DATA "When the new heaven and earth shall own"
DATA "The Prince of Peace their King,"
DATA "And the whole world send back the song"
DATA "Which now the angels sing."
DATA "**** Jingle Bells ****"
DATA "Dashing through the snow"
DATA "On a one-horse open sleigh,"
DATA "Over the fields we go,"
DATA "Laughing all the way;"
DATA "Bells on bob-tail ring,"
DATA "making spirits bright,"
DATA "What fun it is to ride and sing"
DATA "A sleighing song tonight"
DATA "Jingle bells, jingle bells,"
DATA "jingle all the way!"
DATA "O what fun it is to ride"
DATA "In a one-horse open sleigh"
DATA "A day or two ago,"
DATA "I thought I'd take a ride,"
DATA "And soon Miss Fanny Bright"
DATA "Was seated by my side;"
DATA "The horse was lean and lank;"
DATA "Misfortune seemed his lot;"
DATA "He got into a drifted bank,"
DATA "And we, we got upsot."
DATA "Jingle Bells, Jingle Bells,"
DATA "Jingle all the way!"
DATA "What fun it is to ride"
DATA "In a one-horse open sleigh."
DATA "A day or two ago,"
DATA "the story I must tell"
DATA "I went out on the snow"
DATA "And on my back I fell;"
DATA "A gent was riding by"
DATA "In a one-horse open sleigh,"
DATA "He laughed as there"
DATA "I sprawling lie,"
DATA "But quickly drove away."
DATA "Jingle Bells, Jingle Bells,"
DATA "Jingle all the way!"
DATA "What fun it is to ride"
DATA "In a one-horse open sleigh."
DATA "Now the ground is white"
DATA "Go it while you're young,"
DATA "Take the girls tonight"
DATA "And sing this sleighing song;"
DATA "Just get a bob-tailed bay"
DATA "two-forty as his speed"
DATA "Hitch him to an open sleigh"
DATA "And crack! you'll take the lead."
DATA "Jingle Bells, Jingle Bells,"
DATA "Jingle all the way!"
DATA "What fun it is to ride"
DATA "In a one-horse open sleigh."
DATA "**** Joy To The World ****"
DATA "Joy to the world! The Lord is come."
DATA "Let earth receive her King"
DATA "Let every heart"
DATA "Prepare Him room"
DATA "And Saints and angels sing"
DATA "And Saints and angels sing"
DATA "And Saints and Saints and angels sing"
DATA "Joy to the world, the Saviour reigns"
DATA "Let Saints their songs employ"
DATA "While fields and floods"
DATA "rocks, hills and plains"
DATA "Repeat the sounding joy"
DATA "Repeat the sounding joy"
DATA "Repeat, Repeat, the sounding joy"
DATA "Joy to the world with truth and grace"
DATA "And makes the nations prove"
DATA "The glories of His righteousness"
DATA "And wonders of His love"
DATA "And wonders of His love"
DATA "And wonders and wonders of His love"
DATA "No more will sin and sorrow grow,"
DATA "Nor thorns infest the ground;"
DATA "He'll come and make the blessings flow"
DATA "Far as the curse was found,"
DATA "Far as the curse was found,"
DATA "Far as, far as the curse was found."
DATA "He rules the world with truth and grace,"
DATA "And gives to nations proof"
DATA "The glories of His righteousness,"
DATA "And wonders of His love;"
DATA "And wonders of His love;"
DATA "And wonders, wonders of His love."
DATA "Rejoice! Rejoice in the Most High,"
DATA "While Israel spreads abroad"
DATA "Like stars that glitter in the sky,"
DATA "And ever worship God,"
DATA "And ever worship God,"
DATA "And ever, and ever worship God."
DATA "**** O Come, All Ye Faithful ****"
DATA "O come, all ye faithful,"
DATA "Joyful and triumphant,"
DATA "O come ye,"
DATA "O come ye to Bethlehem;"
DATA "Come and behold Him"
DATA "Born the King of angels;"
DATA "O come, let us adore Him,"
DATA "O come, let us adore Him,"
DATA "O come, let us adore Him,"
DATA "Christ, the Lord."
DATA "Sing, choirs of angels,"
DATA "Sing in exultation,"
DATA "Sing, all ye citizens"
DATA "of heaven above;"
DATA "Glory to God,"
DATA "Glory in the highest;"
DATA "O come, let us adore Him,"
DATA "O come, let us adore Him,"
DATA "O come, let us adore Him,"
DATA "Christ, the Lord."
DATA "Yea, Lord, we greet Thee,"
DATA "Born this happy morning,"
DATA "Jesus, to Thee be"
DATA "all glory given;"
DATA "Son of the Father,"
DATA "Now in flesh appearing;"
DATA "O come, let us adore Him,"
DATA "O come, let us adore Him,"
DATA "O come, let us adore Him,"
DATA "Christ, the Lord."
DATA "**** O Holy Night ****"
DATA "O holy night,"
DATA "the stars are brightly shining;"
DATA "It is the night of"
DATA "our dear Savior's birth!"
DATA "Long lay the world"
DATA "in sin and error pining,"
DATA "Till He appeared"
DATA "and the soul felt its worth."
DATA "A thrill of hope,"
DATA "the weary world rejoices,"
DATA "For yonder breaks"
DATA "a new and glorious morn."
DATA "Fall on your knees,"
DATA "O hear the angel voices!"
DATA "O night divine,"
DATA "O night when Christ was born!"
DATA "O night divine, O night,"
DATA "O night divine!"
DATA "Led by the light of Faith"
DATA "serenely beaming,"
DATA "With glowing hearts"
DATA "by His cradle we stand."
DATA "So led by light of a star"
DATA "sweetly gleaming,"
DATA "Here came the wise men"
DATA "from Orient land."
DATA "The King of Kings lay thus"
DATA "in lowly manger,"
DATA "In all our trials"
DATA "born to be our Friend!"
DATA "He knows our need,"
DATA "To our weakness no stranger;"
DATA "Behold your King!"
DATA "Before the lowly bend!"
DATA "Behold your King! your King!"
DATA "before Him bend."
DATA "Truly He taught us"
DATA "to love one another;"
DATA "His law is love and"
DATA "His gospel is peace."
DATA "Chains shall He break"
DATA "for the slave is our brother"
DATA "And in His name"
DATA "all oppression shall cease."
DATA "Sweet hymns of joy in"
DATA "grateful chorus raise we,"
DATA "Let all within us"
DATA "praise His holy name!"
DATA "Christ is the Lord,"
DATA "Oh praise His name forever,"
DATA "His pow'r and glory evermore proclaim"
DATA "His pow'r and glory"
DATA "evermore proclaim."
DATA "**** O Little Town of Bethlehem ****"
DATA "O little town of Bethlehem,"
DATA "How still we see thee lie."
DATA "Above thy deep and dreamless sleep"
DATA "The silent stars go by;"
DATA "Yet in thy dark streets shineth"
DATA "The everlasting Light;"
DATA "The hopes and fears of all the years"
DATA "Are met in thee tonight."
DATA "For Christ is born of Mary,"
DATA "And, gathered all above"
DATA "While mortals sleep, the angels keep"
DATA "Their watch of wondering love."
DATA "O morning stars, together"
DATA "Proclaim the holy birth."
DATA "And praises sing to God the King."
DATA "And peace to men on earth."
DATA "How silently, how silently"
DATA "The wondrous gift is given!"
DATA "So God imparts to human hearts"
DATA "The blessings of His heaven."
DATA "No ear may hear His coming;"
DATA "But in this world of sin,"
DATA "Where meek souls will receive Him,"
DATA "still The dear Christ enters in."
DATA "Where children, pure and happy,"
DATA "Pray to the Blessed Child;"
DATA "Where misery cries out to thee,"
DATA "Son of the Mother mild;"
DATA "Where charity stands watching,"
DATA "And faith holds wide the door,"
DATA "The dark night wakes, the glory breaks,"
DATA "and Christmas comes once more."
DATA "O Holy Child of Bethlehem,"
DATA "Descend to us, we pray;"
DATA "Cast out our sin and enter in;"
DATA "Be born in us today!"
DATA "We hear the Christmas angels"
DATA "The great glad tidings tell;"
DATA "O come to us, abide with us,"
DATA "Our Lord Emmanuel!"
DATA "**** Rudolph The Red-Nosed Reindeer ****"
DATA "You know Dasher and Dancer"
DATA "And Prancer and Vixen,"
DATA "Comet and Cupid"
DATA "And Donner and Blitzen."
DATA "But do you recall"
DATA "The most famous reindeer of all?"
DATA "Rudolph the red-nosed reindeer"
DATA "(reindeer)"
DATA "Had a very shiny nose"
DATA "(like a light bulb)"
DATA "And if you ever saw it"
DATA "(saw it)"
DATA "You would even say it glows"
DATA "(like a flash light)"
DATA "All of the other reindeer"
DATA "(reindeer)"
DATA "Used to laugh and call him names"
DATA "(like Pinochio)"
DATA "They never let poor Rudolph"
DATA "(Rudolph)"
DATA "Play in any reindeer games"
DATA "(like Monopoly)"
DATA "Then one foggy Christmas Eve"
DATA "Santa came to say"
DATA "(Ho Ho Ho)"
DATA "Rudolph with your nose so bright"
DATA "Won't you guide my sleigh tonight?"
DATA "Then all the reindeer loved him"
DATA "(loved him)"
DATA "And they shouted out with glee"
DATA "(yippee)"
DATA "'Rudolph the red-nosed reindeer"
DATA "(reindeer)"
DATA "You'll go down in history!'"
DATA "(like Columbus)"
DATA "**** Silent Night ****"
DATA "Silent night, holy night!"
DATA "All is calm, All is bright"
DATA "Round yon Virgin, Mother and Child"
DATA "Holy Infant so Tender and mild,"
DATA "Sleep in heavenly peace,"
DATA "Sleep in heavenly peace."
DATA "Silent night, holy night!"
DATA "Shepherds quake at the sight!"
DATA "Glories stream from heaven afar;"
DATA "Heavenly hosts sing Al-le-lu-ia!"
DATA "Christ the Saviour is born!"
DATA "Christ the Saviour is born!"
DATA "Silent night, holy night!"
DATA "Wondrous star, lend thy light!"
DATA "With the angels let us sing"
DATA "Alleluia to our King!"
DATA "Christ the Saviour is here,"
DATA "Jesus the Saviour is here!"
DATA "Silent night, Holy night!"
DATA "Son of God, love's pure light"
DATA "Radiant beams from Thy holy face,"
DATA "with the dawn of redeeming grace,"
DATA "Jesus Lord at thy birth;"
DATA "Jesus Lord at thy birth."
DATA "**** The First Noel ****"
DATA "The first Noel the angels did say"
DATA "Was to certain poor shepherds"
DATA "in fields as they lay,"
DATA "In fields where they lay"
DATA "keeping their sheep"
DATA "On a cold winter's night"
DATA "that was so deep."
DATA "Noel Noel Noel Noel!"
DATA "Born is the King of Israel!"
DATA "They looked up and saw a star"
DATA "Shining in the East beyond them far,"
DATA "And to the earth it gave great light,"
DATA "And so it continued both day and night."
DATA "Noel Noel Noel Noel!"
DATA "Born is the King of Israel!"
DATA "And by the light of that same star"
DATA "Three wise men came from country far,"
DATA "To seek for a King was their intent"
DATA "And to follow the star"
DATA "wherever it went."
DATA "Noel Noel Noel Noel!"
DATA "Born is the King of Israel!"
DATA "This star drew nigh to the northwest"
DATA "Over Bethlehem it took its rest,"
DATA "And there it did both stop and stay"
DATA "Right over the place where Jesus lay."
DATA "Noel Noel Noel Noel!"
DATA "Born is the King of Israel!"
DATA "Then did they know assuredly"
DATA "Within that house the King did lie:"
DATA "One entered in then for to see,"
DATA "And found the Babe in poverty:"
DATA "Noel Noel Noel Noel!"
DATA "Born is the King of Israel!"
DATA "Then entered in those wise men three"
DATA "Full reverently upon their knee,"
DATA "And offered there in His presence"
DATA "Their gold, and myrrh and frankincense."
DATA "Noel Noel Noel Noel!"
DATA "Born is the King of Israel!"
DATA "Then let us all with one accord"
DATA "Sing praises to our heavenly Lord,"
DATA "That hath made heaven"
DATA "and earth of naught"
DATA "And with His blood"
DATA "mankind hath bought."
DATA "Noel Noel Noel Noel!"
DATA "Born is the King of Israel!"
DATA "**** The Shepherd's Carol (round) ****"
DATA "Mary, Mary hush, see the Child"
DATA "Joseph, Joseph, look see how mild"
DATA "This is Jesus; this is our King"
DATA "This is our Savior, his praises we sing."
DATA "**** The Twelve Days of Christmas ****"
DATA "On the first day of Christmas"
DATA "my true love sent to me:"
DATA "A partridge in a pear tree."
DATA "On the second day of Christmas"
DATA "my true love sent to me:"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the third day of Christmas"
DATA "my true love sent to me:"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the fourth day of Christmas"
DATA "my true love sent to me:"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the fifth day of Christmas"
DATA "my true love sent to me:"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the sixth day of Christmas"
DATA "my true love sent to me:"
DATA "Six geese a laying,"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the seventh day of Christmas"
DATA "my true love sent to me:"
DATA "Seven swans a swimming,"
DATA "Six geese a laying,"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the eighth day of Christmas"
DATA "my true love sent to me:"
DATA "Eight maids a milking,"
DATA "Seven swans a swimming,"
DATA "Six geese a laying,"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the ninth day of Christmas"
DATA "my true love sent to me:"
DATA "Nine ladies dancing,"
DATA "Eight maids a milking,"
DATA "Seven swans a swimming,"
DATA "Six geese a laying,"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the tenth day of Christmas"
DATA "my true love sent to me:"
DATA "Ten lords a leaping,"
DATA "Nine ladies dancing,"
DATA "Eight maids a milking,"
DATA "Seven swans a swimming,"
DATA "Six geese a laying,"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the eleventh day of Christmas"
DATA "my true love sent to me:"
DATA "Eleven pipers piping,"
DATA "Ten lords a leaping,"
DATA "Nine ladies dancing,"
DATA "Eight maids a milking,"
DATA "Seven swans a swimming,"
DATA "Six geese a laying,"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "On the twelfth day of Christmas"
DATA "my true love sent to me:"
DATA "Twelve drummers drumming,"
DATA "Eleven pipers piping,"
DATA "Ten lords a leaping,"
DATA "Nine ladies dancing,"
DATA "Eight maids a milking,"
DATA "Seven swans a swimming,"
DATA "Six geese a laying,"
DATA "Five golden rings,"
DATA "Four calling birds,"
DATA "Three French Hens,"
DATA "Two turtle doves"
DATA "And a Partridge in a pear tree."
DATA "**** Up On the Housetop ****"
DATA "Up on the housetop"
DATA "reindeer pause,"
DATA "Out jumps good old Santa Claus."
DATA "Down thru' the chimney"
DATA "with lots of toys,"
DATA "All for the little ones,"
DATA "Christmas joys."
DATA "Ho, ho, ho!"
DATA "Who wouldn't go!"
DATA "Ho, ho, ho!"
DATA "Who wouldn't go!"
DATA "Up on the housetop,"
DATA "click, click, click,"
DATA "Down thru' the chimney"
DATA "with good Saint Nick."
DATA "First comes the stocking"
DATA "of little Nell,"
DATA "Oh, dear Santa"
DATA "fill it well;"
DATA "Give her a dolly"
DATA "that laughs and cries"
DATA "One that will open"
DATA "and shut her eyes."
DATA "Ho, ho, ho!"
DATA "Who wouldn't go!"
DATA "Ho, ho, ho!"
DATA "Who wouldn't go!"
DATA "Up on the housetop,"
DATA "click, click, click,"
DATA "Down thru' the chimney"
DATA "with good Saint Nick."
DATA "Next comes the stocking"
DATA "of little Will,"
DATA "Oh just see"
DATA "what a glorious fill"
DATA "Here is a hammer"
DATA "and lots of tacks,"
DATA "Also a ball"
DATA "and a whip that cracks."
DATA "Ho, ho, ho!"
DATA "Who wouldn't go!"
DATA "Ho, ho, ho!"
DATA "Who wouldn't go!"
DATA "Up on the housetop,"
DATA "click, click, click,"
DATA "Down thru' the chimney"
DATA "with good Saint Nick."
DATA "**** We Three Kings ****"
DATA "[all sing]"
DATA "We three kings of orient are,"
DATA "bearing gifts we traverse afar"
DATA "Field and fountain,"
DATA "moor and mountain,"
DATA "following yonder star."
DATA "O star of wonder, star of night,"
DATA "star with royal beauty bright."
DATA "Westward leading, still proceeding,"
DATA "Guide us to thy perfect light."
DATA "[Melchior sings]"
DATA "Born a King on Bethlehem's plain,"
DATA "Gold I bring to crown Him again"
DATA "King for ever, ceasing never"
DATA "over us all to reign."
DATA "[all sing]"
DATA "O star of wonder, star of night,"
DATA "star with royal beauty bright."
DATA "Westward leading, still proceeding,"
DATA "Guide us to thy perfect light."
DATA "[Casper sings]"
DATA "Frankincense to offer have I,"
DATA "incense owns a Deity nigh"
DATA "Prayer and praising, all men raising,"
DATA "Worship Him, God most high."
DATA "[all sing]"
DATA "O star of wonder, star of night,"
DATA "star with royal beauty bright."
DATA "Westward leading, still proceeding,"
DATA "Guide us to thy perfect light."
DATA "[Balthazar sings]"
DATA "Myrrh is mine,"
DATA "its bitter perfume breathes"
DATA "a life of gathering gloom."
DATA "Sorrowing, sighing, bleeding, dying,"
DATA "sealed in the stone cold tomb."
DATA "[all sing]"
DATA "O star of wonder, star of night,"
DATA "star with royal beauty bright."
DATA "Westward leading, still proceeding,"
DATA "Guide us to thy perfect light."
DATA "Glorious now behold Him arise,"
DATA "King and God and Sacrifice!"
DATA "Al-le-lu-ia, al-le-lu-ia,"
DATA "heaven to earth replies."
DATA "O star of wonder, star of night,"
DATA "star with royal beauty bright."
DATA "Westward leading, still proceeding,"
DATA "Guide us to thy perfect light."
DATA "**** We Wish You A Merry Christmas ****"
DATA "We wish you a merry Christmas"
DATA "We wish you a merry Christmas"
DATA "We wish you a merry Christmas"
DATA "And a happy New Year."
DATA "Glad tidings we bring"
DATA "To you and your kin;"
DATA "Glad tidings for Christmas"
DATA "And a happy New Year!"
DATA "We want some figgy pudding"
DATA "We want some figgy pudding"
DATA "We want some figgy pudding"
DATA "Please bring it right here!"
DATA "Glad tidings we bring"
DATA "To you and your kin;"
DATA "Glad tidings for Christmas"
DATA "And a happy New Year!"
DATA "We won't go until we get some"
DATA "We won't go until we get some"
DATA "We won't go until we get some"
DATA "So bring it out here!"
DATA "Glad tidings we bring"
DATA "To you and your kin;"
DATA "Glad tidings for Christmas"
DATA "And a happy New Year!"
DATA "We wish you a Merry Christmas"
DATA "We wish you a Merry Christmas"
DATA "We wish you a Merry Christmas"
DATA "And a happy New Year."
DATA "Glad tidings we bring"
DATA "To you and your kin;"
DATA "Glad tidings for Christmas"
DATA "And a happy New Year!"
DATA "**** What Child Is This? ****"
DATA "What Child is this, who laid to rest,"
DATA "On Mary's lap is sleeping?"
DATA "Whom angels greet with anthems sweet"
DATA "While shepherds watch are keeping?"
DATA "This, this is Christ the King"
DATA "Whom shepherds guard and angels sing."
DATA "Haste, haste to bring Him laud,"
DATA "The Babe, the Son of Mary."
DATA "Why lies He in such mean estate"
DATA "Where ox and ass are feeding?"
DATA "Good Christian, fear: for sinners here,"
DATA "The silent Word is pleading."
DATA "This, this is Christ the King"
DATA "Whom shepherds guard and angels sing."
DATA "Haste, haste to bring Him laud,"
DATA "The Babe, the Son of Mary."
DATA "Nails, spear, shall pierce Him through,"
DATA "The Cross be borne, for me, for you:"
DATA "Hail, hail, the Word made flesh,"
DATA "The Babe, the Son of Mary!"
DATA "This, this is Christ the King"
DATA "Whom shepherds guard and angels sing."
DATA "Haste, haste to bring Him laud,"
DATA "The Babe, the Son of Mary."
DATA "So bring Him incense, gold and myrrh;"
DATA "Come peasant, king to own Him."
DATA "The King of Kings salvation brings;"
DATA "Let loving hearts enthrone Him."
DATA "This, this is Christ the King"
DATA "Whom shepherds guard and angels sing."
DATA "Haste, haste to bring Him laud,"
DATA "The Babe, the Son of Mary."
DATA "Raise, raise, the song on high,"
DATA "The Virgin sings her lullaby:"
DATA "Joy joy for Christ is born,"
DATA "The Babe, the Son of Mary!"
DATA "This, this is Christ the King"
DATA "Whom shepherds guard and angels sing."
DATA "Haste, haste to bring Him laud,"
DATA "The Babe, the Son of Mary."
DATA "**** While Shepherds Watched Their Flocks ****"
DATA "While shepherds watched their flocks by night,"
DATA "All seated on the ground,"
DATA "The angel of the Lord came down,"
DATA "And glory shone around."
DATA "'Fear not,' said he, for mighty dread"
DATA "Had seized their troubled mind,"
DATA "'Glad tidings of great joy I bring"
DATA "To you and all mankind.'"
DATA "'To you, in David's town this day,"
DATA "Is born of David's line"
DATA "The Savior who is Christ the Lord,"
DATA "And this shall be the sign:"
DATA "The heavenly Babe you there shall find"
DATA "To human view displayed,"
DATA "All meanly wrapped in swathing bands,"
DATA "And in a manger laid.'"
DATA "Thus spake the seraph, and forthwith"
DATA "Appeared a shining throng"
DATA "Of angels praising God and thus"
DATA "Addressed their joyful song:"
DATA "'All glory be to God on high"
DATA "And on the earth be peace,"
DATA "Goodwill henceforth from heaven to men"
DATA "Begin and never cease.'"
DATA "**** With Wondering Awe ****"
DATA "With wondering awe the wise men saw"
DATA "The star in heaven springing,"
DATA "And with delight, in peaceful night,"
DATA "They heard the angel singing:"
DATA "Hosanna, hosanna, hosanna to His name!"
DATA "By light of star they traveled far"
DATA "To seek the lowly manger,"
DATA "A humble bed wherein was laid"
DATA "The wondrous little Stranger."
DATA "Hosanna, hosanna, hosanna to His name!"
DATA "And still is found, the world around,"
DATA "The old and hallowed story,"
DATA "And still is sung in every tongue"
DATA "The angels' song of glory:"
DATA "Hosanna, hosanna, hosanna to His name!"
DATA "The heavenly star its rays afar"
DATA "On every land is throwing,"
DATA "And shall not cease till holy peace"
DATA "In all the earth is growing."
DATA "Hosanna, hosanna, hosanna to His name!"
DATA "EOD"
 

Less than 30 songs here, but the format should be simple enough that anyone can add the lyrics to whatever they like to this listing without any problems. View them on your screen, or print them to a file to carry on your phone/ipad as you go and serenade your neighbors for X-Mas. :D

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 10, 2020, 01:19:11 pm

There's some really cool stuff posted here. It made me throw something together. Here's an old school animated Christmas card. A little snow, a little tree, a little present, a little Santa, a little music. Merry Christmas!

- Dav

Code: QB64: [Select]

'=================
'CHRISTMAS2020.bas
'=================
'Christmas card to the QB64 community.
'Coded by Dav, DEC/2020
 
'Shows a liite snow, santa, tree, present, animation, music.
'Merry Christmas.
 
SCREEN _NEWIMAGE(868, 540, 32)
 
DIM SHARED wht& 'subs use this...
wht& = _RGB(255, 255, 255) 'white color
 
ON TIMER(.5) GOSUB ANIMATE
 
_PRINTMODE _KEEPBACKGROUND
 
 
'======  draw white color outlines first ...
 
'Draw tree star
CLINE ("199129209145214126234126219113232095211101201083196102176102192117180134199129")
 
'Draw the tree
CLINE ("199129175168190168156210168210142237160237129276141276110312132312102348120348")
CLINE ("120348093385108394136399172402242402283399316393327387300348312348284311309311")
CLINE ("309311276275289275258236272236246209259209224168239168214126")
CLINE ("173402181435234435242402")
 
'Draw fireplace
CLINE ("613328613275618272618268613269613215607209612206613199")
CLINE ("467345489346493206529188582188627204627344649344")
CLINE ("507327506276503274506270505216514207513196")
CLINE ("448340418358417364692364692359669342")
CLINE ("490345508328613328626345")
LINE (422, 105)-(697, 166), wht&, B: LINE (449, 166)-(466, 344), wht&, B
LINE (648, 166)-(669, 345), wht&, B: LINE (481, 0)-(481, 104), wht&
LINE (631, 0)-(631, 104), wht&
 
'draw santa
CLINE ("514208540214560217583215603211611207613199")
CLINE ("524210524252539257561218580254594251598230595213")
CLINE ("582254591271591275589275590280593284599282598278606278613274")
CLINE ("539258529275529278531280530283523284522280514282506276")
CLINE ("529189556195569194587190")
CLINE ("594251598270613269")
CLINE ("526253523272506270")
 
'draw window
CLINE ("000104157104157000"): CLINE ("000093146093146000")
CLINE ("035093035028146028"): CLINE ("028093028028000028")
CLINE ("000022028022028000"): CLINE ("035000035022146022")
 
'draw present
CLINE ("412428388416375425383446402446425434459438452407422425421422412428")
CLINE ("377432353433352451421470488451487435420448403446391446")
CLINE ("419448422469420515359492358452"): CLINE ("420437447444470439459438")
CLINE ("470439469456454460455442"): CLINE ("386433395430404433")
CLINE ("458433487436467440")
LINE (412, 428)-(416, 438), wht&: LINE (421, 424)-(424, 434), wht&
LINE (427, 430)-(443, 423), wht&: LINE (352, 434)-(380, 440), wht&
LINE (373, 440)-(372, 456), wht&: LINE (392, 446)-(392, 461), wht&
LINE (450, 461)-(450, 504), wht&: LINE (463, 458)-(463, 499), wht&
LINE (420, 516)-(482, 491), wht&: LINE (482, 491)-(481, 452), wht&
LINE (378, 458)-(378, 500), wht&: LINE (395, 462)-(394, 505), wht&
 
'draw walls (left side)
LINE (0, 190)-(173, 190), wht&: LINE (244, 190)-(449, 190), wht&
LINE (0, 206)-(159, 206), wht&: LINE (257, 206)-(449, 206), wht&
LINE (0, 338)-(109, 338), wht&: LINE (305, 338)-(449, 338), wht&
 
'draw walls (right side)
CLINE ("669192805192867229"): CLINE ("669209805209867244")
CLINE ("669341806341867390"): LINE (805, 0)-(805, 341), wht&
 
 
'======= Paint in the colors....
 
CPAINT ("371435362445366469424443407455408491441454438484371435466436478446473471"), _RGB(31, 255, 31)
CPAINT ("400436420430440430380450446440460450385475455475"), _RGB(255, 0, 0)
CPAINT ("750260380240060240660222543118455183"), _RGB(76, 109, 138)
CPAINT ("525056638214600345153019033026"), _RGB(40, 57, 72)
CPAINT ("707075499209620246297077"), _RGB(67, 87, 123)
CPAINT ("569192537226582236"), _RGB(205, 4, 23)
CPAINT ("515235557278603253"), _RGB(80, 120, 153)
CPAINT ("786202092198322199"), _RGB(83, 120, 153)
CPAINT ("827217842226"), _RGB(74, 107, 136)
PAINT (207, 417), _RGB(176, 65, 13), wht&
PAINT (204, 113), _RGB(255, 255, 69), wht&
PAINT (204, 239), _RGB(0, 94, 0), wht&
PAINT (650, 470), _RGB(28, 40, 50), wht&
PAINT (840, 120), _RGB(56, 80, 102), wht&
PAINT (842, 285), _RGB(62, 89, 114), wht&
PAINT (567, 206), wht&, wht&
 
'draw santas thought box
LINE (657, 20)-(790, 70), wht&, BF
LINE (637, 100)-(680, 70), wht&
LINE (637, 100)-(734, 70), wht&
PAINT (680, 77), wht&, wht&
COLOR _RGB(0, 0, 0)
_PRINTSTRING (662, 27), "I KNEW I ate"
_PRINTSTRING (662, 45), "too much turkey"
 
'=====================================================
 
 
TIMER ON
 
'Play We wish you a Merry Christmas song...
Music$ = "mbt160o2g4o3c4c8d8c8o2b8a4a4a4o3d4d8e8d8c8o2b4g4g4o3e4e8f8"
Music$ = Music$ + "e8d8c4o2a4g8g8a4o3d4o2b4o3c2o2g4o3c4c4c4o2b2b4o3"
Music$ = Music$ + "c4o2b4a4g2o3d4e4d4c4o3g4o2g4g8g8a4o3d4o2b4o3c2"
Music$ = Music$ + "o2g4o3c4c8d8c8o2b8a4a4a4o3d4d8e8d8c8o2b4g4g4"
Music$ = Music$ + "o3e4e8f8e8d8c4o2a4g8g8a4o3d4o2b4o3c2"
PLAY Music$
 
'Show until keypress
DO: LOOP UNTIL INKEY$ <> ""
 
 
END
 
'======================================================================
 
 
 
'======
ANIMATE:
'======
 
'show a little snow in window frames
SNOW 0, 0, 27, 20 'top left frame
SNOW 36, 0, 145, 20 'top right frame
SNOW 0, 29, 27, 90 'bottom left
SNOW 36, 29, 145, 91 'bottom right
 
'Draw/color ornaments
CCIRCLE ("198157051981871123019805191224062302230717126011")
CCIRCLE ("217250082562550515430209195295122282900425427806")
CCIRCLE ("256303051493390718033008209321092433451528032906")
CCIRCLE ("1543751319136804230383062863630927838707")
 
'blink a message
IF INT(RND * 2) + 1 = 1 THEN COLOR _RGB(0, 0, 0) ELSE COLOR _RGB(255, 255, 255)
 
_PRINTSTRING (450, 128), "M E R R Y  C H R I S T M A S"
 
RETURN
 
 
'==========================================================================
 
SUB CLINE (a$)
    'draws continuious white line based on string of x/y cordinates
    '(yes, I could have used DRAW instead, but wanted to roll my own...)
    'set first line draw position
    LINE (VAL(MID$(a$, 1, 3)), VAL(MID$(a$, 4, 3)))-(VAL(MID$(a$, 7, 3)), VAL(MID$(a$, 10, 3))), wht&
    'continue based on last line position
    FOR d = 13 TO LEN(a$) STEP 6
        LINE -(VAL(MID$(a$, d, 3)), VAL(MID$(a$, d + 3, 3))), wht&
    NEXT
END SUB
 
SUB CPAINT (a$, clr&)
    'paints string of cordinates with color, stops at wht& color
    FOR t = 1 TO LEN(a$) STEP 6
        PAINT (VAL(MID$(a$, t, 3)), VAL(MID$(a$, t + 3, 3))), clr&, wht&
    NEXT
END SUB
 
SUB CCIRCLE (a$)
    'Draw circles based on string of x/y/r data, colors it too
    FOR t = 1 TO LEN(a$) STEP 8
        CIRCLE (VAL(MID$(a$, t, 3)), VAL(MID$(a$, t + 3, 3))), VAL(MID$(a$, t + 6, 2)), wht&
        clr& = INT(RND * 5) + 1 'pick from 5 random colors
        IF clr& = 1 THEN clr& = _RGB(128, 255, 255) 'almost white
        IF clr& = 2 THEN clr& = _RGB(255, 255, 69) 'yellow
        IF clr& = 3 THEN clr& = _RGB(205, 4, 23) 'red
        IF clr& = 4 THEN clr& = _RGB(31, 255, 32) 'green
        IF clr& = 5 THEN clr& = _RGB(0, 31, 221) 'blue
        PAINT (VAL(MID$(a$, t, 3)), VAL(MID$(a$, t + 3, 3))), clr&, wht&
    NEXT
END SUB
 
SUB SNOW (x1, y1, x2, y2)
    'random snow pattern in given window
    LINE (x1, y1)-(x2, y2), _RGB(0, 0, 0), BF 'snow plow
    FOR x = x1 TO x2
        FOR y = y1 TO y2
            IF INT(RND * 200) = 1 THEN PSET (x, y), wht&
        NEXT
    NEXT
END SUB
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 10, 2020, 01:44:30 pm

Ahh-ha! That's cute Dav!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 10, 2020, 02:28:55 pm

Awesome idea Steve, another way to make QB64 into a useful tool. :)

Dav, that's just incredible. You must have spent hours on that. Good job!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 10, 2020, 02:44:57 pm

Thanks, ya'll. Yep, I did spend too much time on it.

I just edited the code to add a Santa's thought box. Forgot to add it. Run it again to read what santa says.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 10, 2020, 04:34:52 pm

LOL good one. :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 10, 2020, 04:47:55 pm

Very nice work, Dav!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 10, 2020, 07:09:08 pm

I worked on the Christmas Tree Ornaments one again for most of the day today and made it much better. I learned a little bit from B+'s mod. Making many of them was easier than I thought. :) I got caught in a minor snag when the different shapes of them slowed and sped up the lyrics on the title bar a fraction so I changed it completely to TIMER. On my last one I was using the number of rotation degree on the ornament for the lyrics as well and it just doesn't work with many of them. Plus TIMER is a lot better for different types of computers. I also have it change to new ornaments every couple of seconds with completely different colors. :) The program ends when the song finishes. I also found out some more things about the PLAY command in that you only need one "MB" command in the string as well as any other command, which you put at the start of your list of PLAY commands. I changed the octave of the song to a bit more bass also. I'm pretty happy about this one. Tell me what you think, thanks.

Edit: I just remembered this this won't work right before midnight because of the TIMER, which counts up from midnight. So I made it so the program stops if it's a few seconds before midnight or less. When it ends, it tells you to please run it after midnight because of the TIMER. This certain code probably won't be tested because I very rarely stay up past midnight. But I believe it works.

Code: QB64: [Select]

'Musical Christmas Tree Ornaments
'Made on December 10, 2020.
'by SierraKen
'Music Notes and Lyrics found here: https://www.piano-keyboard-guide.com/how-to-play-jingle-bells-easy-piano-keyboard-tutorial-for-beginners/
 
DIM i AS LONG
DIM orn AS LONG
DIM ornx(30), orny(30), size(30)
DIM x AS LONG, y AS LONG
DIM image AS LONG, scale AS SINGLE, rotation AS SINGLE
 
JingleBells
start:
READ lyrics$
IF lyrics$ = "done" THEN END
_TITLE lyrics$
IF orn& <> 0 THEN _FREEIMAGE orn&
RANDOMIZE TIMER
t = 1
i& = _NEWIMAGE(800, 600, 32)
SCREEN i&
ornament
orn& = _COPYIMAGE(0)
FOR o = 1 TO 30
    ornx(o) = RND * _WIDTH
    orny(o) = RND * _HEIGHT
    size(o) = RND
    x = ornx(o)
    y = orny(o)
    scale = size(o)
    rotation = turn
    image = orn&
    RotoZoom x, y, image, scale, rotation
NEXT o
CLS
oldt = TIMER
IF oldt > 86327 THEN CLS: PRINT "Please run this program after midnight.": PRINT "It won't work right before midnight because of the TIMER it uses.": END
DO
    _LIMIT 60
    FOR oo = 1 TO 30
        x = ornx(oo)
        y = orny(oo)
        scale = size(oo)
        rotation = turn
        image = orn&
        RotoZoom x, y, image, scale, rotation
    NEXT oo
    _DELAY .01
    _DISPLAY
    CLS
    a$ = INKEY$
    IF a$ = CHR$(27) THEN END
    turn = turn + 1
    t = TIMER - oldt
    IF t > 2.37 THEN GOTO start:
LOOP
 
song:
DATA "Jingle bells, jingle bells."
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh hey"
DATA "Jingle bells, jingle bells"
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh"
DATA "Dashing through the snow"
DATA "On a one horse open sleigh"
DATA "O'er the fields we go,"
DATA "Laughing all the way"
DATA "Bells on bob tail ring,"
DATA "making spirits bright"
DATA "What fun it is to laugh and sing"
DATA "A sleighing song tonight, Oh"
DATA "Jingle bells, jingle bells"
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh hey"
DATA "Jingle bells, jingle bells"
DATA "Jingle all the way"
DATA "Oh, what fun it is to ride"
DATA "In a one horse open sleigh"
DATA "done"
 
SUB JingleBells
    PLAY "MB O3 L5 E E E E E E"
    PLAY "E G C D E"
    PLAY "F F F F F E E"
    PLAY "E E E D D E D G"
    PLAY "E E E E E E"
    PLAY "E G C D E"
    PLAY "F F F F F E E"
    PLAY "E E G G F D C"
 
    PLAY "G E D C G"
    PLAY "G G G E D C A"
    PLAY "A F E D B"
    PLAY "A G F D E"
    PLAY "G E D C G"
    PLAY "G E D C A"
    PLAY "A A F E D G G G"
    PLAY "G A G F D C G"
 
    PLAY "E E E E E E"
    PLAY "E G C D E"
    PLAY "F F F F F E E"
    PLAY "E E E D D E D G"
    PLAY "E E E E E E"
    PLAY "E G C D E"
    PLAY "F F F F F E E"
    PLAY "E E G G F D C"
END SUB
 
SUB ornament
    c1 = INT(RND * 155) + 100
    c2 = INT(RND * 155) + 100
    c3 = INT(RND * 155) + 100
    shade = 0
    FOR cir = .01 TO 130 STEP .1
        shade = shade - .1
        CIRCLE (400, 300), cir, _RGB32(c1 + shade, c2 + shade, c3 + shade)
    NEXT cir
    yy = 300
    c4 = INT(RND * 155) + 100
    c5 = INT(RND * 155) + 100
    c6 = INT(RND * 155) + 100
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy - 40.5
    CIRCLE (400, yy), 124, _RGB32(c4, c5, c6), 2 * _PI, _PI, .4
    yy = yy - 30.5
    CIRCLE (400, yy), 105, _RGB32(c4, c5, c6), 2 * _PI, _PI, .39
    yy = 300
    yy = yy + 22.5
    CIRCLE (400, yy), 130, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 125, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 110, _RGB32(c4, c5, c6), 2 * _PI, _PI, .5
    yy = yy + 22.5
    CIRCLE (400, yy), 75, _RGB32(c4, c5, c6), , , .5
    yy = yy + 22.5
    CIRCLE (400, yy), 15, _RGB32(c4, c5, c6), , , .5
END SUB
 
SUB RotoZoom (X AS LONG, Y AS LONG, Image AS LONG, Scale 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 / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
    FOR i& = 0 TO 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
        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
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: OldMoses on December 10, 2020, 07:28:21 pm

A simple little tree topper. I wasn't expecting the gold effect.

Code: QB64: [Select]

DIM o(4) AS SINGLE
DIM i(4) AS SINGLE
 
SCREEN _NEWIMAGE(600, 600, 32)
 
a = _PI * 2 / 5: b = a / 2: r = _PI * 2 / 360
c1& = &HFFFF0000: c2& = &HFF00FF00
 
FOR x = 0 TO 4
    o(x) = x * a
    i(x) = x * a - b
NEXT x
 
x = 0: d = 1
DO
    CLS
    FOR k = 0 TO 100 STEP 5
        FOR j = 0 TO 4
            LINE (SIN(o(j) + (x * r)) * (200 - k) + 300, COS(o(j) + (x * r)) * (200 - k) + 300)-_
                (SIN(i(j) + (x * r)) * (80 - k) + 300, COS(i(j) + (x * r)) * (80 - k) + 300), c1&
            LINE (SIN(o(j) + (x * r)) * (200 - k) + 300, COS(o(j) + (x * r)) * (200 - k) + 300)-_
                (SIN(i(j) + a + (x * r)) * (80 - k) + 300, COS(i(j) + a + (x * r)) * (80 - k) + 300), c1&
        NEXT j
        SWAP c1&, c2&
    NEXT k
    IF x MOD 72 = 0 THEN
        d = -d: SWAP c1&, c2&
    END IF
    x = x + d
    _LIMIT 100
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 10, 2020, 08:08:20 pm

I just updated my last code above because of the TIMER before midnight problem. TIMER counts up from midnight and the program wouldn't work if you started it right before midnight. So I added code that ends the program if it's near midnight, and explains why.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 10, 2020, 08:09:56 pm

OldMoses that's really cool looking!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 10, 2020, 09:31:06 pm

Thanks, @Petr. Nice spinning Star, @OldMoses. I like the your spinning ornaments, @SierraKen. Hey, I like everything posted here. Nice tree up there especially, @bplus.

I'm trying to come up with a way to make mine a folded card at the beginning, then when you click on it to open, it unfolds like a card showing the drawing screen and plays - like those store bought cards do.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 10, 2020, 11:48:32 pm

Yeah Ken yours is super, fun to compare to your first :)

Old Moses, I am glad someone thought to bring in a star!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 13, 2020, 01:05:22 pm

Hi guys, and here is my output. It is bigger source code and forum can not load it. It is my Christmas 2020 theme program.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: johnno56 on December 13, 2020, 01:44:39 pm

Hi Petr,

The program downloaded fine but did not run. It was expecting 'mp3' and 'font' files...

J

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 13, 2020, 01:48:24 pm

OK. Source code upgraded, font is now in the source code. Try it again, please. It is running correctly under Windows. (previous version also)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 13, 2020, 02:53:31 pm

Petr, that's totally amazing. I never knew so many sounds can be put into one program like that. And your 3D is always incredible. Great job!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 13, 2020, 05:10:56 pm

Well done, @Petr! Enjoyable. I like the screen fading, and the audio fading with the scene makes it more realistic. I never get tired of listening to Silent Night. And the cracking firewood sound in background gives the scene a warmer feeling.

For some reason the program crashes for me during Silent night playback, I get this error alert message: gluBuild2DMipmaps failed. So I haven't made it through the whole program, but what I can see I like very much.

I'm using Windows7-32bit, QB64-GL v1.4 32bit.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 13, 2020, 06:04:32 pm

+1 Wow nice production Petr!

My system played Silent Night at least 3 times, Windows laptop 64 bit QB64 v1.4 stable.

Feliz Navidad :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: NOVARSEG on December 13, 2020, 09:33:57 pm

Petr
Excellent!!!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 14, 2020, 12:48:17 pm

Hi i find memory leak in my program. Please goto row 1192 and find "_FREEIMAGE virt" on row 1197. Add to row 1198 this: _FREEIMAGE Ve(TVO_S + 13).T so as in this short program list:

TeVe(4).T = 0
TeVe(4).T = _COPYIMAGE(virt, 33)
TeVe(4).S = 1

_DEST pred
_FREEIMAGE virt

_FREEIMAGE Ve(TVO_S + 13).T
Cube3D -.5, 0, 2.8, .7, .5, .1, 0, TeVe(), coordinates()
INARR coordinates(), Ve(), TVO_S

END SUB

SUB Krb
FOR S = 1 TO 6
Sofa(S).T = KRB_textura&

memory usage now is cca 206 megabytes. I find no more bugs (just chaotic programming).

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 14, 2020, 01:04:02 pm

I fixed it Petr, thanks.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 14, 2020, 04:04:53 pm

Here is another one from me. It shows snow falling on a hill that piles up a bit, and also onto a Christmas Tree on top of the hill.

Code: QB64: [Select]

SCREEN _NEWIMAGE(800, 600, 32)
DIM sx(600), sy(600), rr(600)
DIM stackx(2000), stacky(2000), stackr(2000)
DIM cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG
size = 1
_TITLE "Merry Christmas!!!"
DO
    _LIMIT 100
    cx = 400: cy = 1100: r = 700: c = _RGB32(127, 255, 127)
    fillCircle cx, cy, r, c
    'Christmas Tree
    tx = 390: ty = 400: r = 10: c = _RGB32(255, 0, 0)
    LINE (tx, ty)-(tx + 20, ty - 75), _RGB32(183, 127, 127), BF
    'left side
    LINE (tx, ty - 75)-(tx - 150, ty - 75), _RGB32(127, 255, 127)
    LINE (tx - 150, ty - 75)-(tx, ty - 150), _RGB32(127, 255, 127)
    cx = tx - 150: cy = ty - 75
    fillCircle cx, cy, r, c
    LINE (tx, ty - 150)-(tx - 100, ty - 150), _RGB32(127, 255, 127)
    LINE (tx - 100, ty - 150)-(tx, ty - 200), _RGB32(127, 255, 127)
    cx = tx - 100: cy = ty - 150
    fillCircle cx, cy, r, c
    LINE (tx, ty - 200)-(tx - 50, ty - 200), _RGB32(127, 255, 127)
    LINE (tx - 50, ty - 200)-(tx + 5, ty - 250), _RGB32(127, 255, 127)
    cx = tx - 50: cy = ty - 200
    fillCircle cx, cy, r, c
    'right side
    LINE (tx + 20, ty - 75)-(tx + 170, ty - 75), _RGB32(127, 255, 127)
    LINE (tx + 170, ty - 75)-(tx + 20, ty - 150), _RGB32(127, 255, 127)
    cx = tx + 170: cy = ty - 75
    fillCircle cx, cy, r, c
    LINE (tx + 20, ty - 150)-(tx + 120, ty - 150), _RGB32(127, 255, 127)
    LINE (tx + 120, ty - 150)-(tx + 20, ty - 200), _RGB32(127, 255, 127)
    cx = tx + 120: cy = ty - 150
    fillCircle cx, cy, r, c
    LINE (tx + 20, ty - 200)-(tx + 70, ty - 200), _RGB32(127, 255, 127)
    LINE (tx + 70, ty - 200)-(tx + 5, ty - 250), _RGB32(127, 255, 127)
    cx = tx + 70: cy = ty - 200
    fillCircle cx, cy, r, c
    cx = tx + 5: cy = ty - 260
    r = 10
    c = _RGB32(255, 255, 127)
    fillCircle cx, cy, r, c
    tt = INT(RND * 100) + 1
    IF tt > 95 THEN
        a = a + 1
        IF a > 500 THEN a = 1
        sx(a) = RND * _WIDTH
        sy(a) = 1
        rr(a) = RND * 5
    END IF
    FOR t = 1 TO 500
        sy(t) = sy(t) + 1
        cx = sx(t): cy = sy(t)
        r = rr(t)
        c = _RGB32(255, 255, 255)
        fillCircle cx, cy, r, c
        IF POINT(sx(t), sy(t) + rr(t) + 1) = _RGB32(127, 255, 127) THEN GOTO stacked:
        IF POINT(sx(t), sy(t) + rr(t) + 1) = _RGB32(255, 255, 127) THEN GOTO stacked:
        IF POINT(sx(t), sy(t) + rr(t) + 1) = _RGB32(255, 0, 0) THEN GOTO stacked:
    NEXT t
    nex:
    IF snow <> 0 THEN
        FOR sn = 1 TO snow
            cx = stackx(sn)
            cy = stacky(sn)
            r = stackr(sn)
            c = _RGB32(252, 252, 252)
            fillCircle cx, cy, r, c
        NEXT sn
    END IF
    _DISPLAY
    LINE (0, 0)-(_WIDTH, _HEIGHT), _RGB32(0, 0, 0), BF
LOOP
 
stacked:
snow = snow + 1
IF snow > 1800 THEN snow = 1: size = 1
IF snow / 200 = INT(snow / 200) THEN size = size * 1.4
stackx(snow) = sx(t)
stacky(snow) = sy(t) - (size / 2)
stackr(snow) = rr(t) + size
sx(t) = -200: sy(t) = 800
GOTO nex:
 
'from Steve Gold standard
SUB fillCircle (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
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 14, 2020, 04:34:46 pm

Nice one, @SierraKen.

@Petr: That fixed it for me. Nice Christmas demo you made.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 14, 2020, 05:02:37 pm

@SierraKen Nice work!
@Dav I'm glad it's okay now :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 14, 2020, 05:20:15 pm

Made a little ornament thing. Draws random color ornament balls like you see on Christmas trees around here. Nothing great, I just felt like making something.

- Dav

Code: QB64: [Select]

'=============
'Ornaments.bas
'=============
'Draws random Christmas ornaments
'Coded by Dav, DEC/2020
 
SCREEN _NEWIMAGE(600, 600, 32)
 
DO
    x = RND * _WIDTH: y = RND * _HEIGHT 'random x/y
    size = 50 + RND * 50 'random size ornament
 
    'select random ornament color,red,greem or blue
    SELECT CASE INT(RND * 3) + 1
        CASE 1: r = (RND * 100) + 155: g = 100: b = 100 'red
        CASE 2: g = (RND * 100) + 155: r = 100: b = 100 'green
        CASE 3: b = (RND * 100) + 155: r = 100: g = 100 'blue
    END SELECT
 
    ball x, y, size, r, g, b
 
    _LIMIT 30
 
LOOP
 
SUB ball (x, y, size, r, g, b)
    'draws a gradient ball
    FOR s = 1 TO size STEP .5
        CIRCLE (x, y), s, _RGB(r, g, b)
        r = r - 1: g = g - 1: b = b - 1
    NEXT
    'Draw top of ornament
    LINE (x - 10, y - size - 10)-(x + 10, y - size), _RGB(r, g, b), BF
END SUB
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: OldMoses on December 14, 2020, 05:47:10 pm

@Petr that was completely amazing! Well done.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 14, 2020, 05:51:40 pm

Thanks guys. Awesome ornaments Dav!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Pete on December 14, 2020, 07:31:03 pm

Anyone made Rudolf or Olive, yet?

Pete

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: johnno56 on December 15, 2020, 04:54:34 am

You finish off the bauble with a rectangle of the same rgb colour. I was thinking... stop laughing... What if the rectangles were 'center-gradient-based". The left-hand side of the rectangle starts off as pale grey; blends to a darker grey in the center; blends to a lighter grey towards the right-hand side. To give the "top" the illusion of being cylindrical... I don't know the correct way to explain it. I hope I am making sense? Just a thought...

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: STxAxTIC on December 15, 2020, 07:25:21 am

Why invent something new when I can release a greatest hits album?

My (first?) holiday contribution comes as a FluidCraft level. Compile the code below to an EXE, and then drag+drop the attached file.

Code: QB64: [Select]

' Version 2020-12-15
 
OPTION _EXPLICIT
 
DO UNTIL _SCREENEXISTS: LOOP
_TITLE "FluidCraft"
 
SCREEN _NEWIMAGE(1024, 768, 32)
'_FULLSCREEN , _SMOOTH
 
RANDOMIZE TIMER
 
TYPE Vector
    x AS DOUBLE
    y AS DOUBLE
END TYPE
 
TYPE ShadeVector
    shadered AS DOUBLE
    shadegreen AS DOUBLE
    shadeblue AS DOUBLE
    shadealpha AS DOUBLE
END TYPE
 
TYPE ShadeElement
    TheName AS STRING
    TheShade AS ShadeVector
END TYPE
 
TYPE Pixel
    position AS Vector
    velocity AS Vector
    acceleration AS Vector
    size AS DOUBLE
    TheShade AS ShadeVector
END TYPE
 
DIM SHARED ShadeData(8) AS ShadeElement
DIM SHARED ActiveShade AS ShadeVector
DIM SHARED PixelCloud(3000) AS Pixel
DIM SHARED ObjectSize AS DOUBLE
DIM SHARED GridSize AS Vector
ObjectSize = 6
GridSize.x = 1 + INT(_WIDTH / ObjectSize)
GridSize.y = 1 + INT(_HEIGHT / ObjectSize)
DIM SHARED Level(GridSize.x, GridSize.y) AS ShadeVector
 
CALL InitializeAll
CALL LoadFile
DO
    CALL UserInput
    CLS
    CALL DrawBorder
    CALL DrawPixels
    CALL DrawLevel
    CALL Dynamics
    CALL DrawOverlay
    _DISPLAY
    _LIMIT 30
LOOP
 
END
 
SUB DrawBorder
    DIM k AS INTEGER
    LINE (0, 0)-(_WIDTH, _HEIGHT), _RGB32(255, 0, 255, 255), BF
    FOR k = 6 TO _HEIGHT - 1 - 6
        LINE (6, k)-(_WIDTH - 6, k), _RGB32(255 * k / _HEIGHT, 0, 255 * (1 - k / _HEIGHT), 255)
    NEXT
    LINE (12, 12)-(_WIDTH - 12, _HEIGHT - 12), _RGB32(0, 0, 0, 255), BF
    LINE (12, 12)-(18 * (UBOUND(ShadeData) + 1) - 1 + 6 + 12, 38 + 12), _RGB32(0, 0, 255, 255), BF
    LINE (12, 12)-(18 * (UBOUND(ShadeData) + 1) - 1 + 6 + 6, 38 + 6), _RGB32(255, 0, 255, 255), BF
    LINE (12, 12)-(18 * (UBOUND(ShadeData) + 1) - 1 + 6, 38), _RGB32(0, 0, 0, 255), BF
END SUB
 
SUB DrawPixels
    DIM k AS INTEGER
    DIM x AS DOUBLE
    DIM y AS DOUBLE
    DIM s AS DOUBLE
    FOR k = 1 TO UBOUND(PixelCloud)
        x = PixelCloud(k).position.x
        y = PixelCloud(k).position.y
        s = PixelCloud(k).size
        CALL clinebf(x - s, y - s, x + s, y + s, _RGBA(PixelCloud(k).TheShade.shadered, PixelCloud(k).TheShade.shadegreen, PixelCloud(k).TheShade.shadeblue, PixelCloud(k).TheShade.shadealpha))
    NEXT
END SUB
 
SUB DrawLevel
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM x AS DOUBLE
    DIM y AS DOUBLE
    DIM s AS DOUBLE
    s = ObjectSize
    FOR i = 1 TO GridSize.x
        FOR j = 1 TO GridSize.y
            x = (i - 1) * s
            y = (j - 1) * s
            IF (Level(i, j).shadered > 5) OR (Level(i, j).shadegreen > 5) OR (Level(i, j).shadeblue > 5) THEN
                CALL slinebf(x - s / 2, y - s / 2, x + s / 2 - 1, y + s / 2 - 1, _RGBA(Level(i, j).shadered, Level(i, j).shadegreen, Level(i, j).shadeblue, Level(i, j).shadealpha))
            END IF
        NEXT
    NEXT
END SUB
 
SUB DrawOverlay
    DIM k AS INTEGER
    IF ActiveShade.shadered < 5 AND ActiveShade.shadegreen < 5 AND ActiveShade.shadeblue < 5 THEN
        LINE (ObjectSize * INT(_MOUSEX / ObjectSize) - ObjectSize / 2 - 1, ObjectSize * INT(_MOUSEY / ObjectSize) - ObjectSize / 2 - 1)-(ObjectSize * INT(_MOUSEX / ObjectSize) + ObjectSize / 2 - 1 + 1, ObjectSize * INT(_MOUSEY / ObjectSize) + ObjectSize / 2 - 1 + 1), _RGBA(255, 255, 255, 255), B
    END IF
    LINE (ObjectSize * INT(_MOUSEX / ObjectSize) - ObjectSize / 2, ObjectSize * INT(_MOUSEY / ObjectSize) - ObjectSize / 2)-(ObjectSize * INT(_MOUSEX / ObjectSize) + ObjectSize / 2 - 1, ObjectSize * INT(_MOUSEY / ObjectSize) + ObjectSize / 2 - 1), _RGBA(ActiveShade.shadered, ActiveShade.shadegreen, ActiveShade.shadeblue, ActiveShade.shadealpha), BF
    FOR k = 1 TO UBOUND(ShadeData)
        LINE (18 * k + 1, 18)-(18 * (k + 1) - 1, 32), _RGB32(ShadeData(k).TheShade.shadered, ShadeData(k).TheShade.shadegreen, ShadeData(k).TheShade.shadeblue, ShadeData(k).TheShade.shadealpha), BF
        LINE (18 * k + 1, 18)-(18 * (k + 1) - 1, 32), _RGB32(255, 255, 255, 255), B
    NEXT
END SUB
 
SUB InitializeAll
    DIM k AS INTEGER
    ShadeData(1).TheName = "Red"
    ShadeData(1).TheShade.shadered = 255
    ShadeData(1).TheShade.shadegreen = 0
    ShadeData(1).TheShade.shadeblue = 0
    ShadeData(1).TheShade.shadealpha = 255
    ShadeData(2).TheName = "Blue"
    ShadeData(2).TheShade.shadered = 0
    ShadeData(2).TheShade.shadegreen = 0
    ShadeData(2).TheShade.shadeblue = 255
    ShadeData(2).TheShade.shadealpha = 255
    ShadeData(3).TheName = "Green"
    ShadeData(3).TheShade.shadered = 0
    ShadeData(3).TheShade.shadegreen = 255
    ShadeData(3).TheShade.shadeblue = 0
    ShadeData(3).TheShade.shadealpha = 255
    ShadeData(4).TheName = "White"
    ShadeData(4).TheShade.shadered = 255
    ShadeData(4).TheShade.shadegreen = 255
    ShadeData(4).TheShade.shadeblue = 255
    ShadeData(4).TheShade.shadealpha = 255
    ShadeData(5).TheName = "Yellow"
    ShadeData(5).TheShade.shadered = 255
    ShadeData(5).TheShade.shadegreen = 255
    ShadeData(5).TheShade.shadeblue = 0
    ShadeData(5).TheShade.shadealpha = 255
    ShadeData(6).TheName = "Aqua"
    ShadeData(6).TheShade.shadered = 0
    ShadeData(6).TheShade.shadegreen = 255
    ShadeData(6).TheShade.shadeblue = 255
    ShadeData(6).TheShade.shadealpha = 255
    ShadeData(7).TheName = "Violet"
    ShadeData(7).TheShade.shadered = 255
    ShadeData(7).TheShade.shadegreen = 0
    ShadeData(7).TheShade.shadeblue = 255
    ShadeData(7).TheShade.shadealpha = 255
    ShadeData(8).TheName = "Black"
    ShadeData(8).TheShade.shadered = 0
    ShadeData(8).TheShade.shadegreen = 0
    ShadeData(8).TheShade.shadeblue = 0
    ShadeData(8).TheShade.shadealpha = 255
 
    FOR k = 1 TO UBOUND(PixelCloud)
        PixelCloud(k).size = 3
        PixelCloud(k).acceleration.x = 0
        PixelCloud(k).acceleration.y = 0
        PixelCloud(k).velocity.x = 0
        PixelCloud(k).velocity.y = 0
        PixelCloud(k).position.x = (RND - .5) * _WIDTH * .8
        PixelCloud(k).position.y = (RND - .5) * _HEIGHT * .8
        CALL SetPixelShade(k, 0, 0, 255, 150)
    NEXT
 
    ActiveShade.shadered = 255
    ActiveShade.shadegreen = 0
    ActiveShade.shadeblue = 0
    ActiveShade.shadealpha = 255
 
END SUB
 
SUB SetPixelShade (i AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER)
    PixelCloud(i).TheShade.shadered = r
    PixelCloud(i).TheShade.shadegreen = g
    PixelCloud(i).TheShade.shadeblue = b
    PixelCloud(i).TheShade.shadealpha = a
END SUB
 
SUB UserInput
    DIM mb1 AS INTEGER
    DIM mb2 AS INTEGER
    DIM mb3 AS INTEGER
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM k AS INTEGER
    mb1 = 0
    mb2 = 0
    mb3 = 0
    DO WHILE _MOUSEINPUT
        IF (_MOUSEBUTTON(1) = -1) AND (mb1 <> 1) THEN
            mb1 = -1
            i = 1 + INT(_MOUSEX / ObjectSize)
            j = 1 + INT(_MOUSEY / ObjectSize)
            Level(i, j).shadered = ActiveShade.shadered
            Level(i, j).shadegreen = ActiveShade.shadegreen
            Level(i, j).shadeblue = ActiveShade.shadeblue
            Level(i, j).shadealpha = ActiveShade.shadealpha
        END IF
        IF ((_MOUSEBUTTON(2) = -1) AND (mb2 <> -1)) THEN
            mb2 = -1
            i = ObjectSize * INT(_MOUSEX / ObjectSize)
            j = ObjectSize * INT(_MOUSEY / ObjectSize)
            ActiveShade.shadered = _RED32(POINT(i, j))
            ActiveShade.shadegreen = _GREEN32(POINT(i, j))
            ActiveShade.shadeblue = _BLUE32(POINT(i, j))
            ActiveShade.shadealpha = _ALPHA32(POINT(i, j))
        END IF
    LOOP
    SELECT CASE _KEYHIT
        CASE ASC("e"), ASC("E")
            CALL Export
        CASE ASC("r"), ASC("R")
            FOR k = 1 TO UBOUND(PixelCloud)
                PixelCloud(k).TheShade.shadered = 255
                PixelCloud(k).TheShade.shadegreen = 0
                PixelCloud(k).TheShade.shadeblue = 0
            NEXT
        CASE ASC("b"), ASC("B")
            FOR k = 1 TO UBOUND(PixelCloud)
                PixelCloud(k).TheShade.shadered = 0
                PixelCloud(k).TheShade.shadegreen = 0
                PixelCloud(k).TheShade.shadeblue = 255
            NEXT
        CASE ASC("0")
            FOR k = 1 TO UBOUND(PixelCloud)
                PixelCloud(k).position.x = (RND - .5) * _WIDTH * .8
                PixelCloud(k).position.y = (RND - .5) * _HEIGHT * .8
            NEXT
        CASE 27
            FOR i = 1 TO GridSize.x
                FOR j = 1 TO GridSize.y
                    Level(i, j).shadered = 0
                    Level(i, j).shadegreen = 0
                    Level(i, j).shadeblue = 0
                    Level(i, j).shadealpha = 0
                NEXT
            NEXT
    END SELECT
    'DO WHILE _MOUSEINPUT: LOOP
END SUB
 
SUB Export
    DIM i AS INTEGER
    DIM j AS INTEGER
    OPEN "FluidCraft" + LTRIM$(RTRIM$(STR$(INT(TIMER)))) + ".txt" FOR OUTPUT AS #1
    FOR i = 1 TO UBOUND(Level, 1)
        FOR j = 1 TO UBOUND(Level, 2)
            PRINT #1, i, j, Level(i, j).shadered, Level(i, j).shadegreen, Level(i, j).shadeblue, Level(i, j).shadealpha
        NEXT
    NEXT
    CLOSE #1
END SUB
 
SUB Dynamics
    DIM k AS INTEGER
    FOR k = 1 TO UBOUND(PixelCloud)
        CALL CalculateInfluence(k)
        CALL UpdatePosition(k)
    NEXT
END SUB
 
SUB UpdatePosition (i AS INTEGER)
    DIM dt AS DOUBLE
    DIM damp AS DOUBLE
    DIM brownian AS DOUBLE
    dt = 1
    damp = 0.8
    brownian = .65
    PixelCloud(i).velocity.x = damp * PixelCloud(i).velocity.x + dt * PixelCloud(i).acceleration.x
    PixelCloud(i).velocity.y = damp * PixelCloud(i).velocity.y + dt * PixelCloud(i).acceleration.y
    PixelCloud(i).position.x = PixelCloud(i).position.x + dt * PixelCloud(i).velocity.x + (RND - .5) * brownian
    PixelCloud(i).position.y = PixelCloud(i).position.y + dt * PixelCloud(i).velocity.y + (RND - .5) * brownian
    IF (PixelCloud(i).position.y <= -_HEIGHT / 2 + 2 * PixelCloud(i).size + 1) THEN
        PixelCloud(i).position.y = _HEIGHT / 2 - 2 * PixelCloud(i).size
    END IF
END SUB
 
SUB CalculateInfluence (i AS INTEGER)
    DIM x AS DOUBLE
    DIM y AS DOUBLE
    DIM dx AS DOUBLE
    DIM dy AS DOUBLE
    DIM xr AS DOUBLE
    DIM yr AS DOUBLE
    DIM xg AS DOUBLE
    DIM yg AS DOUBLE
    DIM xb AS DOUBLE
    DIM yb AS DOUBLE
    DIM WPoint(9) AS _UNSIGNED LONG
    x = PixelCloud(i).position.x
    y = PixelCloud(i).position.y
    dx = 2 * PixelCloud(i).size
    dy = 2 * PixelCloud(i).size
    WPoint(7) = cpoint(x - dx, y + dy)
    WPoint(8) = cpoint(x, y + dy)
    WPoint(9) = cpoint(x + dx, y + dy)
    WPoint(4) = cpoint(x - dx, y)
    WPoint(6) = cpoint(x + dx, y)
    WPoint(1) = cpoint(x - dx, y - dy)
    WPoint(2) = cpoint(x, y - dy)
    WPoint(3) = cpoint(x + dx, y - dy)
 
    DIM k AS INTEGER
    DIM WShade(9) AS DOUBLE
    DIM xc AS DOUBLE
    DIM yc AS DOUBLE
    DIM cs AS INTEGER
    cs = 0
    x = 0
    y = 0
 
    ' red
    FOR k = 1 TO 9
        IF (k <> 5) THEN
            IF ((_RED32(WPoint(k)) > 25) AND (_GREEN32(WPoint(k)) < 5) AND (_BLUE32(WPoint(k)) < 25)) THEN
                WShade(k) = _RED32(WPoint(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
            ELSE
                WShade(k) = 0
            END IF
        END IF
    NEXT
    xr = (WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
    yr = (WShade(8) - WShade(2) + (WShade(7) + WShade(9)) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
    x = x + xr
    y = y + yr
 
    ' blue
    FOR k = 1 TO 9
        IF (k <> 5) THEN
            IF ((_RED32(WPoint(k)) < 25) AND (_GREEN32(WPoint(k)) < 5) AND (_BLUE32(WPoint(k)) > 25)) THEN
                WShade(k) = _RED32(WPoint(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
            ELSE
                WShade(k) = 0
            END IF
        END IF
    NEXT
    xb = (WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
    yb = (WShade(8) - WShade(2) + (WShade(7) + WShade(9)) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
    x = x + xb
    y = y + yb
 
    ' green
    FOR k = 1 TO 9
        IF (k <> 5) THEN
            IF ((_RED32(WPoint(k)) < 5) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) < 5)) THEN
                WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
                cs = 1
            ELSE
                WShade(k) = 0
            END IF
        END IF
    NEXT
    xg = -(WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
    yg = (0 - WShade(2) + (0 + 0) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
    x = x + xg
    y = y + yg
 
    ' custom yellow
    FOR k = 1 TO 9
        IF (k <> 5) THEN
            IF ((_RED32(WPoint(k)) > 250) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) < 5)) THEN
                WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
                cs = 1
            ELSE
                WShade(k) = 0
            END IF
        END IF
    NEXT
    xc = (WShade(6) - 0 + (WShade(9) + WShade(3)) / SQR(2) - (0 + 0) / SQR(2))
    yc = 0
    x = x + xc
    y = y + yc
 
    ' custom aqua
    FOR k = 1 TO 9
        IF (k <> 5) THEN
            IF ((_RED32(WPoint(k)) < 5) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) > 250)) THEN
                WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
                cs = 1
            ELSE
                WShade(k) = 0
            END IF
        END IF
    NEXT
    xc = -(WShade(6) - 0 + (WShade(9) + WShade(3)) / SQR(2) - (0 + 0) / SQR(2))
    yc = 0
    x = x + xc
    y = y + yc
 
    ' custom white
    FOR k = 1 TO 9
        IF (k <> 5) THEN
            IF ((_RED32(WPoint(k)) > 250) AND (_GREEN32(WPoint(k)) > 250) AND (_BLUE32(WPoint(k)) > 250)) THEN
                WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
                cs = 1
            ELSE
                WShade(k) = 0
            END IF
        END IF
    NEXT
    xc = -(WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
    yc = -(0 - WShade(2) + (0 + 0) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
    x = x + xc
    y = y + yc
 
    ' custom violet
    FOR k = 1 TO 9
        IF (k <> 5) THEN
            IF ((_RED32(WPoint(k)) > 250) AND (_GREEN32(WPoint(k)) < 5) AND (_BLUE32(WPoint(k)) > 250)) THEN
                WShade(k) = _RED32(WShade(k)) + _GREEN32(WPoint(k)) + _BLUE32(WPoint(k))
                cs = 1
            ELSE
                WShade(k) = 0
            END IF
        END IF
    NEXT
    xc = (WShade(6) - WShade(4) + (WShade(9) + WShade(3)) / SQR(2) - (WShade(7) + WShade(1)) / SQR(2))
    yc = (WShade(8) - WShade(2) + (WShade(7) + WShade(9)) / SQR(2) - (WShade(1) + WShade(3)) / SQR(2))
    x = x + xc
    y = y + yc
 
    ' Conductivity
    IF (cs = 0) THEN
        IF ((xr * xr + yr * yr) > (xb * xb + yb * yb)) THEN
            PixelCloud(i).TheShade.shadered = PixelCloud(i).TheShade.shadered + 64
            IF (PixelCloud(i).TheShade.shadered >= 255) THEN PixelCloud(i).TheShade.shadered = 255
            PixelCloud(i).TheShade.shadeblue = PixelCloud(i).TheShade.shadeblue - 64
            IF (PixelCloud(i).TheShade.shadeblue <= 0) THEN PixelCloud(i).TheShade.shadeblue = 0
        END IF
        IF ((xb * xb + yb * yb) > (xr * xr + yr * yr)) THEN
            PixelCloud(i).TheShade.shadered = PixelCloud(i).TheShade.shadered - 64
            IF (PixelCloud(i).TheShade.shadered <= 0) THEN PixelCloud(i).TheShade.shadered = 0
            PixelCloud(i).TheShade.shadeblue = PixelCloud(i).TheShade.shadeblue + 64
            IF (PixelCloud(i).TheShade.shadeblue >= 255) THEN PixelCloud(i).TheShade.shadeblue = 255
        END IF
    END IF
 
    ' Gravity vs. levity
    IF (cs = 0) THEN
        y = y - (PixelCloud(i).TheShade.shadered - PixelCloud(i).TheShade.shadeblue) / 255
    END IF
 
    ' Normalize acceleration
    IF (ABS(x) < .001) THEN
        PixelCloud(i).acceleration.x = 0
    ELSE
        PixelCloud(i).acceleration.x = -x / SQR(x * x + y * y)
    END IF
    IF (ABS(y) < .001) THEN
        PixelCloud(i).acceleration.y = 0
    ELSE
        PixelCloud(i).acceleration.y = -y / SQR(x * x + y * y)
    END IF
 
    ' Auto-cooling
    IF (cs = 0) THEN
        PixelCloud(i).TheShade.shadered = PixelCloud(i).TheShade.shadered - 2
        IF (PixelCloud(i).TheShade.shadered <= 0) THEN PixelCloud(i).TheShade.shadered = 0
        PixelCloud(i).TheShade.shadeblue = PixelCloud(i).TheShade.shadeblue + 2
        IF (PixelCloud(i).TheShade.shadeblue >= 255) THEN PixelCloud(i).TheShade.shadeblue = 255
    END IF
END SUB
 
FUNCTION cpoint& (x1 AS DOUBLE, y1 AS DOUBLE)
    DIM TheReturn AS _UNSIGNED LONG
    TheReturn = POINT(_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)
    cpoint = TheReturn
END FUNCTION
 
SUB clinebf (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
    LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2 - 0, -y2 + _HEIGHT / 2 + 0), col, BF
END SUB
 
SUB slinebf (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
    LINE (x1, y1)-(x2, y2), col, BF
END SUB
 
SUB cprintstring (y1 AS DOUBLE, a AS STRING)
    _PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y1 + _HEIGHT / 2), a
END SUB
 
SUB LoadFile
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM r AS INTEGER
    DIM g AS INTEGER
    DIM b AS INTEGER
    DIM a AS INTEGER
    IF (COMMAND$ <> "") THEN
        PRINT "Loading..."
        OPEN COMMAND$ FOR INPUT AS #1
        DO WHILE NOT EOF(1)
            INPUT #1, i, j, r, g, b, a
            Level(i, j).shadered = r
            Level(i, j).shadegreen = g
            Level(i, j).shadeblue = b
            Level(i, j).shadealpha = a
        LOOP
        CLOSE #1
    END IF
END SUB
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 15, 2020, 08:55:47 am

@johnno56: That sounds good to me. The top was as afterthought. I should have made it silver or something before posting.

@STxAxTIC: That looks pretty cool...

Here is something I started working on last night, a multi-note PLAY like system using sound files. Since it's Christmas I made it play a Christmas song and will post it here. I wanted to make PLAY songs that used real sounds and play chords, so here it is playing Silent Night. The sound files I ripped from my TankDrum thing.

NOTE: .OGG Alert for those who have problems opening files with .OGG files...

Download (385k)

Here's the source code, but you will need the SPLAY.ZIP above to run it...

- Dav

Note: Edited code to v1.02. (12/15/2020)

Code: QB64: [Select]

'=========
'SPLAY.BAS v1.02
'=========
'A multi-note PLAY-like method using sound files to
'play notes, and allow more than one note at a time.
'This demo plays Silent Night.
'Coded By Dav, DEC/2020
 
'Added: Added Rests (RN).
'Fixed: Replace delay routine. Actually works now.
'Fixed: Allows spaces in note groups ( )
'Added: Added inkey$ bail-out of SUB playing notes
 
'Over time I'll adapt this to math PLAY commands as
'much as possible, but for now heres how you use it:
 
'For now, there only 15 notes playable, about 2 octaves.
' e1 f1 g1 a1 b1 | c2 d2 e2 f2 g2 a2 b2 | c3 d3 e3
 
'You can play a chord of notes by grouping inside ()
' (c2 e2 g2)
 
'Assign current note/rest length values like this...
'WN = Whole note, HN = Half note, DQ = Dotted quarter note
'QN = Quarter note, EN = Eighth note, SN = Sixteenth note
 
'Rests - nothing played, but time continues
'RN = Rest note.  Uses current note length value set.
'For example, to rest a quarter note, do this:
'QN RN
 
'Assign Tempos like this (always must be in 4 characters):
'T120  ... or T060   ...  or  T100
 
'Assign current meter (for whole length value to work)
'M3  (thats for 3/4)....  M4   (Thats for 4/4)
 
 
'=========================================================
 
'Sound file handles
DIM SHARED e1&, f1&, g1&, a1&, b1&, c2&, d2&
DIM SHARED e2&, f2&, g2&, a2&, b2&, c3&, d3&, e3&
DIM SHARED Tempo, Meter, NoteValue 'playing values
 
'Load sound samples
e1& = _SNDOPEN("ogg/e1.ogg"): f1& = _SNDOPEN("ogg/f1.ogg")
g1& = _SNDOPEN("ogg/g1.ogg"): a1& = _SNDOPEN("ogg/a1.ogg")
b1& = _SNDOPEN("ogg/b1.ogg"): c2& = _SNDOPEN("ogg/c2.ogg")
d2& = _SNDOPEN("ogg/d2.ogg"): e2& = _SNDOPEN("ogg/e2.ogg")
f2& = _SNDOPEN("ogg/f2.ogg"): g2& = _SNDOPEN("ogg/g2.ogg")
a2& = _SNDOPEN("ogg/a2.ogg"): b2& = _SNDOPEN("ogg/b2.ogg")
c3& = _SNDOPEN("ogg/c3.ogg"): d3& = _SNDOPEN("ogg/d3.ogg")
e3& = _SNDOPEN("ogg/e3.ogg")
 
 
PRINT "Testing all notes...e1 to e3"
'Set tempo 120, meter 4/4, set sixteen note value, play all notes
SPLAY "t120 m4 sn e1f1g1a1b1c2d2e2f2g2a2b2c3d3e3"
_DELAY 1
 
'Note: You don't have to include spaces, but I did here...
 
PRINT "Playing chords..."
'Note: tempo and meter already set in earlier call, so
'      below will play with that, but you can change it...
SPLAY "qn (c2 e2 g2) rn rn (f2a2c3) (g2b2d3) wn (c3g2e2c2g1)"
_DELAY 1
 
'Now, since it's Christmas, play a Christmas song...
 
DO
    CLS: PRINT
    PRINT "Silent night...";
    SPLAY "t100m3dq(c2e2g2)en(c2f2a2)qn(c2e2g2)wn(g1c2e2)"
    PRINT "Holy night..."
    SPLAY "dq(c2e2g2)en(c2f2a2)qn(c2e2g2)wn(g1c2e2)"
    PRINT "All is calm....";
    SPLAY "hn(d3b2g2)qnd3(g2b2)c3(d3g2f2)"
    PRINT "All is bright..."
    SPLAY "hn(c3g2e2)en(c3g2)f2qn(c2e2g3)d2e2"
    PRINT "Round 'yon virgin...";
    SPLAY "en(a2f2)g2f2g2(a2f2)(g2b2)qn(c3a2f2)(b2g2)(a2f2)"
    PRINT "Mother and child...."
    SPLAY "dq(g2e2c2)en(a2f2)qn(g2e2)(e2c2)d2e2"
    PRINT "Holy Infant so ";
    SPLAY "en(a2f2)g2f2g2(a2f2)(g2b2)qn(c3a2f2)(b2g2)(a2f2)"
    PRINT "Tender and mild."
    SPLAY "dq(g2e2c2)en(a2f2)qn(g2e2)(e2c2)a1g1"
    PRINT "Sleep in heavenly peace...."
    SPLAY "hn(d3b2bg2f2)qn(d2b2)dq(d2f2g2)enc3qn(b2g2f2)wn(e2g2c3)(e3c3g3)"
    PRINT "Sleep in heavenly peace."
    SPLAY "qn(c3g2e2c2)g2e2dq(g2f2d2b1)enf2qnd2wn(c2g1e1)qnc3g2d2"
LOOP UNTIL INKEY$ <> ""
 
 
SUB SPLAY (Music$)
 
    'Set Defaults, just in case empty
    IF Tempo = 0 THEN Tempo = 60
    IF Meter = 0 THEN Meter = 3
    IF NoteValue = 0 THEN NoteValue = 1
 
    Music$ = UCASE$(Music$)
    cur = 1
 
    DO
 
        'skip any spaces
        IF MID$(Music$, cur, 1) = " " THEN cur = cur + 1
 
        'Check for tempo
        IF MID$(Music$, cur, 1) = "T" THEN
            cur = cur + 1
            Tempo = VAL(MID$(Music$, cur, 3)): cur = cur + 3
        END IF
 
        'Check for Meter
        IF MID$(Music$, cur, 1) = "M" THEN
            cur = cur + 1
            Meter = VAL(MID$(Music$, cur, 1)): cur = cur + 1
        END IF
 
        'Get notevalue
        SELECT CASE MID$(Music$, cur, 2)
            CASE IS = "DQ": cur = cur + 2: NoteValue = 1.5
            CASE IS = "EN": cur = cur + 2: NoteValue = .5
            CASE IS = "QN": cur = cur + 2: NoteValue = 1
            CASE IS = "HN": cur = cur + 2: NoteValue = 2
            CASE IS = "WN": cur = cur + 2
                IF Meter = 3 THEN NoteValue = 3 ELSE NoteValue = 4
            CASE IS = "SN": cur = cur + 2: NoteValue = .25
        END SELECT
 
        'If regular note/rest found (not a group)
        SELECT CASE MID$(Music$, cur, 2)
            CASE IS = "E1": _SNDPLAYCOPY e1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "F1": _SNDPLAYCOPY f1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "G1": _SNDPLAYCOPY g1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "A1": _SNDPLAYCOPY a1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "B1": _SNDPLAYCOPY b1&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "C2": _SNDPLAYCOPY c2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "D2": _SNDPLAYCOPY d2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "E2": _SNDPLAYCOPY e2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "F2": _SNDPLAYCOPY f2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "G2": _SNDPLAYCOPY g2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "A2": _SNDPLAYCOPY a2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "B2": _SNDPLAYCOPY b2&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "C3": _SNDPLAYCOPY c3&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "D3": _SNDPLAYCOPY d3&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "E3": _SNDPLAYCOPY e3&: cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
            CASE IS = "RN": cur = cur + 2: _DELAY (60 * NoteValue / Tempo)
        END SELECT
 
        'if group of notes found
        IF MID$(Music$, cur, 1) = "(" THEN
            cur = cur + 1
            'Grab up until ')' found
            Group$ = ""
            DO
                a$ = MID$(Music$, cur, 1): cur = cur + 1
                IF a$ = ")" THEN EXIT DO
                IF a$ <> " " THEN Group$ = Group$ + a$
            LOOP
            FOR N = 1 TO LEN(Group$) STEP 2
                note$ = MID$(Group$, N, 2)
                IF note$ = "E1" THEN _SNDPLAYCOPY e1&
                IF note$ = "F1" THEN _SNDPLAYCOPY f1&
                IF note$ = "G1" THEN _SNDPLAYCOPY g1&
                IF note$ = "A1" THEN _SNDPLAYCOPY a1&
                IF note$ = "B1" THEN _SNDPLAYCOPY b1&
                IF note$ = "C2" THEN _SNDPLAYCOPY c2&
                IF note$ = "D2" THEN _SNDPLAYCOPY d2&
                IF note$ = "E2" THEN _SNDPLAYCOPY e2&
                IF note$ = "F2" THEN _SNDPLAYCOPY f2&
                IF note$ = "G2" THEN _SNDPLAYCOPY g2&
                IF note$ = "A2" THEN _SNDPLAYCOPY a2&
                IF note$ = "B2" THEN _SNDPLAYCOPY b2&
                IF note$ = "C3" THEN _SNDPLAYCOPY c3&
                IF note$ = "D3" THEN _SNDPLAYCOPY d3&
                IF note$ = "E3" THEN _SNDPLAYCOPY e3&
            NEXT
            _DELAY (60 * NoteValue / Tempo)
        END IF
 
        IF cur >= LEN(Music$) THEN EXIT DO
 
        IF INKEY$ <> "" THEN EXIT SUB
 
    LOOP
 
    EXIT SUB
 
END SUB
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 15, 2020, 11:06:55 am

I see Santa's elves have been busy :)

@STxAxTIC what fun to modify a Christmas Card or animation!
[ This attachment cannot be displayed inline in 'Print Page' view ]

I suspect Dav's been smitten by the Christmas spirits ;-))

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 15, 2020, 11:30:52 am

Quote from: bplus on December 15, 2020, 11:06:55 am

I suspect Dav's been smitten by the Christmas spirits ;-))

Trying to get in the mood I guess. Finding it harder to do that this year for some reason.

I just updated the SPLAY program posted above. Fixed something, added something.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 15, 2020, 11:53:15 am

@Dav are the oggs all in separate folder? I have no problems with Explorer if I know where not to go with it but of course I use it to access the bas source. I find it easier to navigate (and perform file maintenance, like Delete, Copy, Move Files and Folders) in Explorer than QB64 IDE so I am in habit of using that specially for downloads. PS I don't visit my BlackJack files except through QB64 IDE because of the oggs.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 15, 2020, 11:56:17 am

No folders in the zip, just the .OGG files and the BAS zipped up altogether. I forget whats the right way to include the .OGG files -- put them in a separate folder?

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 15, 2020, 12:05:32 pm

Quote from: Dav on December 15, 2020, 11:56:17 am

No folders in the zip, just the .OGG files and the BAS zipped up altogether. I forget whats the right way to include the .OGG files -- put them in a separate folder?

- Dav

Yes Oggs in separate and marked folder, for me and I suspect for Windows users that aren't very tech savvy (two v's ??). It's just Windows 10 (only?) Explorer without the downloaded patch you have to get at the Windows Store which means getting an account and possibly being barraged with more Windows updates, notifications or spam.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 15, 2020, 12:41:49 pm

@Dav Very nice work. For me, this is a very exemplary explanation of notes. I saved the program, I have to study it properly in the future.

@STxAxTIC very nice program. Do I see it supposed to simulate something like thermal flow? So I wouldn't dare do that. Just the idea of doing this is just brilliant.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 15, 2020, 12:57:22 pm

Quote

@STxAxTIC very nice program. Do I see it supposed to simulate something like thermal flow? So I wouldn't dare do that. Just the idea of doing this is just brilliant.

Yeah when I just ran FluidCraft without any drawing, I was reminded of my Particles Fountain only taken to a way higher level.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 15, 2020, 01:06:53 pm

@Petr: Thanks!

@bplus: I repackaged the ZIP, putting the ogg files in a separate folder named ogg/.

I also added the option of including rests in the songs now. New ZIP and code.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 15, 2020, 01:12:01 pm

Quote

@bplus: I repackaged the ZIP, putting the ogg files in a separate folder named ogg/.

Thanks @Dav what's your favorite charity?

Update: Beautiful! Soothing for the kind of year we've all had.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: johnno56 on December 15, 2020, 01:27:36 pm

Quote from: Petr on December 13, 2020, 01:48:24 pm

OK. Source code upgraded, font is now in the source code. Try it again, please. It is running correctly under Windows. (previous version also)

Petr,

Thank you for the upgrade. Everything functions as it should.

Very nicely done! Great job!

J

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 15, 2020, 05:44:15 pm

@bplus: Glad you enjoy the program!

Quote from: bplus on December 15, 2020, 01:12:01 pm

Thanks @Dav what's your favorite charity?

As far as donations go, I don't have a favorite. Me and extra money don't seem to meet that often -- so my contributions are of a local volunteering nature. Sometime those TV commercials (like for the hospital that helps sick kids 100% free) nearly makes my eyes puddle up and wish I did have money to contribute to charities.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 15, 2020, 06:19:41 pm

That's really awesome Dav! When I made my Starfield Clock I thought about something like this for the hourly chimes. Right now it only has the PLAY command. You did an impressive job here. Do you mind if I use 1 or 2 of your .ogg sound files for my clock? But I need to know something first, can the chimes play when there's other things going on in the background? That is why I couldn't use the chime example I found a long time ago.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 15, 2020, 06:39:14 pm

@SierraKen: Thanks! Sure, you may use anything i make and post here in your projects. The way the SPLAY SUB is set up (with my added delay) the sound playback would suspend your clock from running while chiming. But you could easily adapt the code to eliminate that problem. Cool thing about _SNDPLAYCOPY is that it won't suspend your program while playing a sound. All you need to do is call the sounds from in your main program (forget the SPLAY SUB) and perhaps set a special TIMER for calling each note in your main loop.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 15, 2020, 10:17:25 pm

Thanks Dav, I tried for a bit tonight but couldn't figure it out, it kept making the sound a bunch of times on each chime. But that's OK, I'm satisfied with what I have. :) If I decide to check it out later I might.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SMcNeill on December 17, 2020, 03:36:59 pm

Here's a little something Xmassy which I tossed together this afternoon. It works better (as in much faster) with external files, but part of the rules here said we should avoid those, so this is what I've got at the moment:

[edit]

Grab the attachment below and run it; the data length in the BAS file is too large for the forum database to handle properly, and can't be included in a post.

If I'd known I couldn't get this to load as is, I wouldn't have bothered to turn it into a singluar file and would've just kept everything externally available. :P

Ah well... Now I need to decide what I want to do next to it (if anything). I'm thinking of having Santa fly across the screen in his sled, with a ribbon trailing behind him, showing the words of the song as it plays for us... And then maybe making this a screensaver for the holidays, on a soundplay loop...

Or maybe I'll just leave it as it is, and not worry over it...

I dunno yet what I'm going to end up doing with it, but here's my little Xmas contribution!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 17, 2020, 04:53:36 pm

Well that's pretty, Steve. I really like the floating snow effect. Has a nice lilt to it that makes it more like snow than just dropping like rain drops. Good screensaver.

Took a while for the converting on my slower laptop, but worth the wait. Nice converting functions there you made....

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SMcNeill on December 17, 2020, 05:12:26 pm

Quote from: Dav on December 17, 2020, 04:53:36 pm

Well that's pretty, Steve. I really like the floating snow effect. Has a nice lilt to it that makes it more like snow than just dropping like rain drops. Good screensaver.

Took a while for the converting on my slower laptop, but worth the wait. Nice converting functions there you made....

- Dav

If you're just interested in the conversion routines, you can find them alone here: https://www.qb64.org/forum/index.php?topic=3379.msg126862#msg126862

Compress and convert images/sound/resource files to BASE-128 encoding, so we can use them internally in DATA statements without any problems. They need to be optimized for speed (use of readbit and setbit would help a lot, but they weren't in our language when I first did these routines), but they're functional and usage can often be hidden behind a startup splash screen, or such, in many cases. ;)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SierraKen on December 17, 2020, 05:24:58 pm

Amazing Steve, very nice.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 18, 2020, 02:31:52 am

Beautiful snow scene Steve!

I finally found an oldie I did in 2015 and translated it to QB64 with some mods:

Code: QB64: [Select]

_TITLE "Sierpinski Decorated" 'b+ 2020-12-18 finally found this oldie
'sierpinski decorated.bas 2015-12-06 SmallBASIC 0.12.1 [B+=MGA]
'Thanks to PeterMaria W for code snips
RANDOMIZE TIMER
CONST SSQ = 700, horizon = 485 ' Side of Square Screen
DIM SHARED QB(15) 'modified old QB 16 color system
QB(0) = &HFF000000
QB(1) = &HFF000088
QB(2) = &HFF008800
QB(3) = &HFF008888
QB(4) = &HFF880000
QB(5) = &HFF880088
QB(6) = &HFF888800
QB(7) = &HFFCCCCCC
QB(8) = &HFF888888
QB(9) = &HFF0000FF
QB(10) = &HFF00FF00
QB(11) = &HFF00FFFF
QB(12) = &HFFFF0000
QB(13) = &HFFFF00FF
QB(14) = &HFFFFFF00
QB(15) = &HFFFFFFFF
 
SCREEN _NEWIMAGE(SSQ + 100, SSQ, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
 
xplus = SSQ
yplus = horizon
nstars = 100
DIM xstar(100), ystar(100), rstar(100)
FOR i = 1 TO 100
    xstar(i) = RND * (SSQ + 100): ystar(i) = RND * horizon:
    IF i < 75 THEN
        rstar(i) = 0
    ELSEIF i < 95 THEN
        rstar(i) = 1
    ELSE
        rstar(i) = 2
    END IF
NEXT
WHILE 1
    CLS
    FOR i = 0 TO horizon
        LINE (0, i)-(SSQ + 100, i), _RGB32(i / horizon * 70, i / horizon * 22, 60 * (i) / horizon)
    NEXT
    land = SSQ - horizon
    FOR i = horizon TO SSQ
        cc = 128 + (i - horizon) / land * 127
        LINE (0, i)-(SSQ + 100, i), _RGB32(cc, cc, cc)
    NEXT
    FOR i = 1 TO 100
        fcirc xstar(i), ystar(i), rstar(i), QB(11)
    NEXT
    pinetree 200, 100
    star xplus, yplus
    xdist = 420 - xplus
    xplus = xplus + .1 * xdist
    ydist = 80 - yplus
    yplus = yplus + .1 * ydist
    _DISPLAY
    _LIMIT 7
WEND
 
SUB star (x, y)
    fcirc x, y, 3, &HFFAAFF00
    LINE (x - 7, y)-(x - 3, y), &HFFAAFF00
    LINE (x + 3, y)-(x + 7, y), &HFFAAFF00
    LINE (x, y - 7)-(x, y - 3), &HFFAAFF00
    LINE (x, y + 3)-(x, y + 7), &HFFAAFF00
    IF x > 419 AND x < 421 AND y > 79 AND y < 81 THEN
        CIRCLE (x, y), 12, &HFFAAFF00
        COLOR &HFFFFFF88, &H00000000
        Text 35, horizon + 90, 85, &HFFAA0000, "Seasons Greetings"
        sier 210, 125, 420, 340
        SLEEP
    END IF
END SUB
 
SUB sier (tlx, tly, width, height)
    ' Sierpinski Christmas.bas modified from Petermaria's
    ax = tlx
    ay = tly + height
    bx = tlx + width
    by = tly + height
    cx = tlx + width / 2
    cy = tly
    px = tlx
    py = tly + height
    FOR n = 0 TO 4000
        fcirc px, py, 2, QB(INT(RND * 16))
        SELECT CASE INT(RND * 3)
            CASE 0
                px = (px + ax) / 2.0
                py = (py + ay) / 2.0
            CASE 1
                px = (px + bx) / 2.0
                py = (py + by) / 2.0
            CASE 2
                px = (px + cx) / 2.0
                py = (py + cy) / 2.0
        END SELECT
    NEXT
    _DISPLAY
END SUB
 
SUB pinetree (x, y)
    'tannen baum by PeterMaria W  orig 440x460
    bpx = 220: bpy = 410
    tpx = bpx
    FOR aa = -4 TO 4
        bpxx = bpx + aa
        bpyy = bpy - 390
        LINE (x + bpxx, y + bpy)-(x + bpx, y + bpyy), _RGB32(30, 30, 0)
    NEXT
    ra = 160
    tpy = bpy - 40
    FOR ht = 1 TO 40
        FOR xs = -100 TO 100 STEP 40
            xsh = xs / 100
            rs = RND * 4 / 10
            tpxx = tpx + (xsh * ra)
            tpyy = tpy - rs * ra
            LINE (x + tpx, y + tpy)-(x + tpxx, y + tpyy), _RGB32(50, 40, 20)
            FOR aa = 1 TO 30
                fra = RND * 10 / 10 * ra
                x1 = tpx + (xsh * fra)
                y1 = tpy - rs * fra
                x2 = tpx + xsh * (fra + ra / 5)
                y2 = tpy - rs * fra + (-rs + (RND * 8) / 10 - 0.4) * (ra / 5)
                LINE (x + x1, y + y1)-(x + x2, y + y2), _RGB32(RND * 120, RND * 70 + 70, RND * 80)
            NEXT
        NEXT
        ra = ra - 4
        tpy = tpy - 9
    NEXT
    _DISPLAY
END SUB
 
'from Steve Gold standard
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 Text (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
    DIM fg AS _UNSIGNED LONG, cur&, I&, multi, xlen
    fg = _DEFAULTCOLOR
    'screen snapshot
    cur& = _DEST
    I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
    _DEST I&
    COLOR K, _RGBA32(0, 0, 0, 0)
    _PRINTSTRING (0, 0), txt$
    multi = textHeight / 16
    xlen = LEN(txt$) * 8 * multi
    _PUTIMAGE (x, y)-STEP(xlen, textHeight), I&, cur&
    COLOR fg
    _FREEIMAGE I&
END SUB
 
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 18, 2020, 02:57:30 am

Very nice work, @Steve. Your program is also IDE destructor :) - goto to row with DATA and press "end" key on the keyboard :) That's why I cut long strings to 450 characters per line to do our IDE well.

@Nice work, BPlus! Better tree than mine :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 18, 2020, 08:13:09 am

Nice one, @bplus.

I was looking for an Christmas oldie to post too, but I think it was on my HD that died. Anyone happen to save that old school Jingle Bell piano thing I posted a few years ago on the [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] forum? It played jingle bells while showing the piano keyboard playing the notes, and displayed the words.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: _vince on December 18, 2020, 09:31:05 am

Nice work guys, I hope I can contribute something when I get some free time soon.

An honorable mention is TheBOB's christmas train. It would get posted on TQBF every year as a tradition, would be nice if someone can pull it up and/or translate it to QB64. (@Pete ?)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 18, 2020, 11:09:21 am

Quote from: _vince on December 18, 2020, 09:31:05 am

Nice work guys, I hope I can contribute something when I get some free time soon.

An honorable mention is TheBOB's christmas train. It would get posted on TQBF every year as a tradition, would be nice if someone can pull it up and/or translate it to QB64. (@Pete ?)

Here 'tis: https://www.qb64.org/forum/index.php?topic=820.msg100360#msg100360

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: STxAxTIC on December 18, 2020, 11:20:58 am

Here is the Sanctum Winter Wonderland update. Let it load, and walk forward. Look all around, find the snowmen and the christmas trees. When you're bored with that, you can wander some more: through the desert, up in space, inside a planet -- or you may go down, down, down all the way to hell.

Code: QB64: [Select]

' Version 2020-12-18
 
OPTION _EXPLICIT
 
DO UNTIL _SCREENEXISTS: LOOP
_TITLE "Sanctum"
 
' Hardware.
'SCREEN _NEWIMAGE(640, 480, 32)
SCREEN _NEWIMAGE(800, 600, 32)
'SCREEN _NEWIMAGE(1024, 768, 32)
 
' Meta
RANDOMIZE TIMER
_FULLSCREEN
_MOUSEHIDE
 
' Color constants.
CONST Aquamarine = _RGB32(127, 255, 212)
CONST Black = _RGB32(0, 0, 0)
CONST Blue = _RGB32(0, 0, 255)
CONST BlueViolet = _RGB32(138, 43, 226)
CONST Chocolate = _RGB32(210, 105, 30)
CONST Cyan = _RGB32(0, 255, 255)
CONST DarkBlue = _RGB32(0, 0, 139)
CONST DarkGoldenRod = _RGB32(184, 134, 11)
CONST DarkGray = _RGB32(169, 169, 169)
CONST DarkKhaki = _RGB32(189, 183, 107)
CONST DeepPink = _RGB32(255, 20, 147)
CONST DodgerBlue = _RGB32(30, 144, 255)
CONST ForestGreen = _RGB32(34, 139, 34)
CONST Gray = _RGB32(128, 128, 128)
CONST Green = _RGB32(0, 128, 0)
CONST Indigo = _RGB32(75, 0, 130)
CONST Ivory = _RGB32(255, 255, 240)
CONST LightSeaGreen = _RGB32(32, 178, 170)
CONST Lime = _RGB32(0, 255, 0)
CONST LimeGreen = _RGB32(50, 205, 50)
CONST Magenta = _RGB32(255, 0, 255)
CONST PaleGoldenRod = _RGB32(238, 232, 170)
CONST Purple = _RGB32(128, 0, 128)
CONST Red = _RGB32(255, 0, 0)
CONST RoyalBlue = _RGB32(65, 105, 225)
CONST SaddleBrown = _RGB32(139, 69, 19)
CONST Sienna = _RGB32(160, 82, 45)
CONST SlateGray = _RGB32(112, 128, 144)
CONST Snow = _RGB32(255, 250, 250)
CONST Sunglow = _RGB32(255, 207, 72)
CONST SunsetOrange = _RGB32(253, 94, 83)
CONST Teal = _RGB32(0, 128, 128)
CONST White = _RGB32(255, 255, 255)
CONST Yellow = _RGB32(255, 255, 0)
 
' Mathematical constants.
CONST pi = 4 * ATN(1)
CONST ee = EXP(1)
 
' Types.
 
TYPE Vector
    x AS DOUBLE
    y AS DOUBLE
    z AS DOUBLE
END TYPE
 
TYPE Camera
    Position AS Vector
    Velocity AS Vector
    Shade AS _UNSIGNED LONG
END TYPE
 
TYPE ClusterElement
    Index AS LONG
    FirstGroup AS LONG
    LastGroup AS LONG
    Centroid AS Vector
    Velocity AS Vector
    Visible AS INTEGER
    MotionType AS INTEGER
END TYPE
 
TYPE GroupElement
    Identity AS LONG
    GroupName AS STRING
    Pointer AS LONG
    Lagger AS LONG
    Volume AS Vector
    FirstVector AS LONG
    LastVector AS LONG
    Centroid AS Vector
    Velocity AS Vector
    Visible AS INTEGER
    Distance2 AS DOUBLE
END TYPE
 
TYPE MissionGroup
    Label AS STRING
    Discovered AS INTEGER
END TYPE
 
' Scale.
DIM SHARED bignumber AS LONG
bignumber = 6000000
 
' Cluster setup.
DIM SHARED ClusterIndexTicker AS LONG
DIM SHARED ClusterFillCounter AS INTEGER
DIM SHARED Cluster(bignumber / 100) AS ClusterElement
ClusterIndexTicker = 0
ClusterFillCounter = 0
 
' Group linked list setup.
DIM SHARED Group(bignumber / 10) AS GroupElement
DIM SHARED GroupIdTicker AS LONG
GroupIdTicker = 0
 
' Path
DIM SHARED FixedPath(25, 86400) AS Vector
DIM SHARED PathIndexTicker AS LONG
PathIndexTicker = 0
 
' Basis vectors defined in three-space.
DIM SHARED xhat(3), yhat(3), zhat(3)
xhat(1) = 1: xhat(2) = 0: xhat(3) = 0
yhat(1) = 0: yhat(2) = 1: yhat(3) = 0
zhat(1) = 0: zhat(2) = 0: zhat(3) = 1
 
' Camera orientation vectors.
DIM SHARED uhat(3), vhat(3), nhat(3)
 
' Camera position.
DIM SHARED PlayerCamera AS Camera
 
' Field-of-view distance.
DIM SHARED fovd
fovd = -192
 
' Clipping planes.
DIM SHARED nearplane(4), farplane(4), rightplane(4), leftplane(4), topplane(4), bottomplane(4)
nearplane(4) = 1
farplane(4) = -180
rightplane(4) = -17 ' (17=35/2=tilesize/2 looks better than 1.)
leftplane(4) = -17
topplane(4) = -17
bottomplane(4) = -17
 
' World vectors.
DIM SHARED vec(bignumber, 3) ' Relative Position
DIM SHARED vec3Dpos(bignumber, 3) ' Absolute osition
DIM SHARED vec3Dvel(bignumber, 3) ' Linear velocity
DIM SHARED vec3Dvis(bignumber) ' Visible toggle
DIM SHARED vec2D(bignumber, 2) ' Projection onto 2D plane
DIM SHARED vec3Dcolor(bignumber) AS LONG ' Original color
DIM SHARED vec2Dcolor(bignumber) AS LONG ' Projected color
 
' Mission.
DIM SHARED MissionTicker AS INTEGER
DIM SHARED Mission(20) AS MissionGroup
 
' Interface.
DIM SHARED ToggleHUD AS INTEGER
DIM SHARED ToggleAnimate AS INTEGER
DIM SHARED FPSReport AS INTEGER
DIM SHARED NumClusterVisible AS LONG
DIM SHARED NumVectorVisible AS LONG
DIM SHARED NumGroupVisible AS LONG
DIM SHARED ClosestGroup AS LONG
 
' Initialize.
ToggleAnimate = 1
ToggleHUD = 1
PlayerCamera.Position.x = -40
PlayerCamera.Position.y = 500 '30
PlayerCamera.Position.z = 40
uhat(1) = COS(0): uhat(2) = SIN(0): uhat(3) = 0
vhat(1) = 0: vhat(2) = 0: vhat(3) = 1
CALL CalculateScreenVectors
 
' Prime main loop.
CALL CreateLevel
CALL CreateMission(10)
 
' Start main loop.
CALL MainLoop
 
END
 
' Subs and Functions
 
SUB CreateMission (ListSize AS INTEGER)
    DIM k AS INTEGER
    DIM a AS STRING
    DIM b AS STRING
    a = ""
    b = ""
    REDIM MissionPool(0) AS STRING
 
    '''
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Atmospheric dust"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Black hole"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Cloudy sky"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Comet 1"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Comet 2"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Comet 3"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Demon orb"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Dirt and sand"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Grave"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Hell sparks"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Laser"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Lush terrain"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Tornado 1"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Tornado 2"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Tornado 3"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Planet center"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Planet column"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Planet interior"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Plasma core"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Pyramid"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Rain"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Singularity"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Snowman 1"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Snowman 2"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Snowman 3"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Tree 1"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Tree 2"
    REDIM _PRESERVE MissionPool(UBOUND(MissionPool) + 1): MissionPool(UBOUND(MissionPool)) = "Tree 3"
 
    '''
 
    MissionTicker = 0
    DO
        k = 1 + INT(RND * UBOUND(MissionPool))
        a = MissionPool(k)
        IF (INSTR(b, a) = 0) THEN
            b = b + a
            MissionTicker = MissionTicker + 1
            Mission(MissionTicker).Label = a
            Mission(MissionTicker).Discovered = 0
        END IF
    LOOP UNTIL (MissionTicker = ListSize)
END SUB
 
SUB CreateLevel
    DIM gtmp AS LONG
    DIM p AS LONG
    DIM n AS SINGLE
    DIM i, j, k AS SINGLE
    DIM u, v, w AS SINGLE
    DIM x0, y0, z0 AS SINGLE
 
    ' Initialize linked list.
    gtmp = CreateNewGroup&(0, 0, 0, 0, 0, 1)
 
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Atmospheric dust
    FOR u = -1400 TO 1400 - 350 STEP 350
        FOR v = -1400 TO 1400 - 350 STEP 350
            FOR i = u TO u + 350 STEP 35
                FOR j = v TO v + 350 STEP 35
                    FOR w = (100 + 35 / 2) TO (800 - 35 + 35 / 2) STEP 35
                        gtmp = NewCube&(gtmp, "Atmospheric dust", 5 * (1 - w / 800), i, j, w, 35, 35, 35, DarkGray, White, Snow, -1)
                    NEXT
                NEXT
            NEXT
            CALL ClusterPinch(gtmp)
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
 
 
 
 
 
 
 
 
 
    'GOTO moo
 
 
 
 
 
 
    ' Black hole
    k = RND * 2 * pi
    x0 = 1000 * COS(k)
    y0 = 1000 * SIN(k)
    z0 = 300
    i = 100
    j = 25
    FOR u = -i TO i STEP j
        FOR v = -i TO i STEP j
            FOR w = -i TO i STEP j
                k = SQR(u * u + v * v + w * w)
                IF k <= i AND k >= i - j THEN
                    gtmp = NewCube&(gtmp, "Black hole", j, x0 + u, y0 + v, z0 + w, j, j, j, DarkGray, White, Snow, -1)
                    CALL SetParticleVelocity(gtmp, -.25 * u / k, -.25 * v / k, -.25 * w / k)
                END IF
            NEXT
        NEXT
    NEXT
    gtmp = NewShell&("Singularity", 10, x0, y0, z0, Black, Black, Black, 2, 5, -1)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Comet
    FOR n = 1 TO 3
        u = RND * 2 * pi
        PathIndexTicker = PathIndexTicker + 1
        FOR p = 1 TO 86400
            FixedPath(PathIndexTicker, p).x = .25 * COS(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
            FixedPath(PathIndexTicker, p).y = .25 * SIN(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
            FixedPath(PathIndexTicker, p).z = .15 * COS(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
        NEXT
        x0 = 150 + (RND - .5) * 2 * 550
        y0 = 150 + (RND - .5) * 2 * 550
        z0 = 200 + RND * 100
        gtmp = NewCube&(gtmp, "Comet" + STR$(n), 300, x0, y0, z0, 25, 25, 25, Teal, Cyan, DodgerBlue, PathIndexTicker)
        FOR k = Group(gtmp).FirstVector TO Group(gtmp).LastVector
            vec3Dvel(k, 1) = (RND - .5) * .20
            vec3Dvel(k, 2) = (RND - .5) * .20
            vec3Dvel(k, 3) = (RND - .5) * .20
        NEXT
        gtmp = NewShell&("Comet" + STR$(n), 15, x0, y0, z0, Teal, Cyan, DodgerBlue, 1, 80, PathIndexTicker)
        CALL ClusterPinch(gtmp)
    NEXT
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Demon orb
    FOR n = 1 TO 6
        u = RND * 2 * pi
        PathIndexTicker = PathIndexTicker + 1
        FOR p = 1 TO 86400
            FixedPath(PathIndexTicker, p).x = .25 * COS(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
            FixedPath(PathIndexTicker, p).y = .25 * SIN(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
            FixedPath(PathIndexTicker, p).z = .15 * COS(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
        NEXT
        x0 = (RND - .5) * 2 * 1000
        y0 = (RND - .5) * 2 * 1000
        z0 = -700 - RND * 100
        gtmp = NewCube&(gtmp, "Demon orb", 300, x0, y0, z0, 25, 25, 25, Red, SunsetOrange, Sunglow, PathIndexTicker)
        FOR k = Group(gtmp).FirstVector TO Group(gtmp).LastVector
            vec3Dvel(k, 1) = (RND - .5) * .20
            vec3Dvel(k, 2) = (RND - .5) * .20
            vec3Dvel(k, 3) = (RND - .5) * .20
        NEXT
        gtmp = NewShell&("Demon orb", 15, x0, y0, z0, Red, SunsetOrange, Sunglow, 1, 80, PathIndexTicker)
        CALL ClusterPinch(gtmp)
    NEXT
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Death Star
    PathIndexTicker = PathIndexTicker + 1
    FOR p = 1 TO 86400
        FixedPath(PathIndexTicker, p).x = -.1 * COS(2 * pi * (24 * 60) * (p - 1) / 86400)
        FixedPath(PathIndexTicker, p).y = -.1 * SIN(2 * pi * (24 * 60) * (p - 1) / 86400)
        FixedPath(PathIndexTicker, p).z = 0
    NEXT
    x0 = 100 + (RND - .5) * 2 * 250
    y0 = 100 + (RND - .5) * 2 * 250
    gtmp = NewShell&("Death Star", 75, x0, y0, 400, Gray, DarkGray, White, 0, 0, PathIndexTicker)
    gtmp = NewShell&("Death Star reactor", 15, x0, y0, 400, Cyan, Teal, Blue, 1, 20, PathIndexTicker)
    gtmp = NewCube&(gtmp, "Plasma core", 300, x0, y0, 400, 25, 25, 25, Cyan, Teal, Blue, PathIndexTicker)
    FOR p = Group(gtmp).FirstVector TO Group(gtmp).LastVector
        vec3Dvel(p, 1) = (RND - .5) * .20
        vec3Dvel(p, 2) = (RND - .5) * .20
        vec3Dvel(p, 3) = (RND - .5) * .20
    NEXT
    FOR n = 10 TO 1 STEP -.5
        gtmp = NewCube&(gtmp, "Laser", 300, x0 + 75 / SQR(2) + (n - 1) * 25, y0 + .5 * n * 25, 400 + 75 / SQR(2) + .5 * (n - 1) * 25, 25, 25, 25, Lime, Green, White, PathIndexTicker)
        FOR p = Group(gtmp).FirstVector TO Group(gtmp).LastVector
            vec3Dvel(p, 1) = (RND - .5) * .50
            vec3Dvel(p, 2) = (RND - .5) * .50
            vec3Dvel(p, 3) = (RND - .5) * .50
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Dirt and sand
    FOR u = -1400 TO 1400 - 350 STEP 350
        FOR v = -1400 TO 1400 - 350 STEP 350
            FOR i = u TO u + 350 STEP 35
                FOR j = v TO v + 350 STEP 35
                    FOR w = 0 - 35 / 2 TO -770 - 35 / 2 STEP -35
                        gtmp = NewCube&(gtmp, "Dirt and sand", 5, i, j, w, 35, 35, 35, SaddleBrown, DarkKhaki, Sienna, -1)
                    NEXT
                NEXT
            NEXT
            CALL ClusterPinch(gtmp)
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Grave and Pyramid (1/2)
    k = RND * pi / 2 - pi / 4
    x0 = 1000 * COS(k)
    y0 = 1000 * SIN(k)
    FOR u = x0 - 160 TO x0 + 160 STEP 80
        FOR v = y0 - 160 TO y0 + 160 STEP 80
            gtmp = NewCube&(gtmp, "Grave", 200, u, v, (1) * 10 - 10 / 2, 10, 10, 10, Gray, SlateGray, DarkGray, -1)
            gtmp = NewCube&(gtmp, "Grave", 200, u, v, (2) * 10 - 10 / 2, 10, 10, 10, Gray, SlateGray, DarkGray, -1)
            gtmp = NewCube&(gtmp, "Grave", 200, u, v, (3) * 10 - 10 / 2, 10, 10, 10, Gray, SlateGray, DarkGray, -1)
            gtmp = NewCube&(gtmp, "Grave", 200, u - 10, v, (4) * 10 - 10 / 2, 10, 10, 10, Gray, SlateGray, DarkGray, -1)
            gtmp = NewCube&(gtmp, "Grave", 200, u, v, (4) * 10 - 10 / 2, 10, 10, 10, Gray, SlateGray, DarkGray, -1)
            gtmp = NewCube&(gtmp, "Grave", 200, u + 10, v, (4) * 10 - 10 / 2, 10, 10, 10, Gray, SlateGray, DarkGray, -1)
            gtmp = NewCube&(gtmp, "Grave", 200, u, v, (5) * 10 - 10 / 2, 10, 10, 10, Gray, SlateGray, DarkGray, -1)
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Grave and Pyramid (2/2)
    k = k + pi
    x0 = 1000 * COS(k)
    y0 = 1000 * SIN(k)
    FOR w = 0 TO 75 STEP 15
        FOR u = -75 + w TO 75 - w STEP 15
            FOR v = -75 + w TO 75 - w STEP 15
                gtmp = NewCube&(gtmp, "Pyramid", 35, x0 + u, y0 + v, w, 13, 13, 13, DarkKhaki, SunsetOrange, DarkGoldenRod, -1)
            NEXT
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Hell Sparks
    FOR u = -1400 TO 1400 - 350 STEP 350
        FOR v = -1400 TO 1400 - 350 STEP 350
            FOR i = u TO u + 350 STEP 35
                FOR j = v TO v + 350 STEP 35
                    gtmp = NewCube&(gtmp, "Hell sparks", 15, i, j, -850, 35, 35, 100, Red, SunsetOrange, Sunglow, -1)
                    CALL SetParticleVelocity(gtmp, 0, 0, .75 + RND * .25)
                NEXT
            NEXT
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Lake of Fire
    gtmp = NewTerrain&("Lake of Fire", 2800, 2800, 35, 0, 0, -900, Red, SunsetOrange, Sunglow, 4, 30)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Planet
    PathIndexTicker = PathIndexTicker + 1
    FOR p = 1 TO 86400
        FixedPath(PathIndexTicker, p).x = .1 * COS(2 * pi * (24 * 60) * (p - 1) / 86400)
        FixedPath(PathIndexTicker, p).y = .1 * SIN(2 * pi * (24 * 60) * (p - 1) / 86400)
        FixedPath(PathIndexTicker, p).z = 0
    NEXT
    x0 = 100 + (RND - .5) * 2 * 250
    y0 = 100 + (RND - .5) * 2 * 250
    gtmp = NewPlanet&(350, 35, x0, y0, 900, PathIndexTicker)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Rain
    FOR u = -350 TO 350 STEP 35
        FOR v = -350 TO 350 STEP 35
            IF (u * u + v * v <= 350 ^ 2) THEN
                gtmp = NewCube&(gtmp, "Rain", 15, u, v, 50, 35, 35, 100, Blue, DodgerBlue, Blue, -1)
                CALL SetParticleVelocity(gtmp, 0, 0, -.75 - RND * .25)
            END IF
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Realm of Heaven
    gtmp = NewTerrain&("Realm of Heaven", 2800, 2800, 35, 0, 0, 1400, BlueViolet, Cyan, White, 4, 30)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Sky and Terrain: Center
    gtmp = NewTerrain&("Cloudy sky", 1400, 1400, 35, 0, 0, 100, RoyalBlue, DarkGray, Snow, 4, 30)
    gtmp = NewTerrain&("Lush terrain", 1400, 1400, 35, 0, 0, 0, Green, LightSeaGreen, Blue, 4, 30)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Sky and Terrain: North
    gtmp = NewTerrain&("Northern winter sky", 2800, 700, 35, 0, 700 + 350, 100, White, DarkBlue, SlateGray, 4, 30)
    gtmp = NewTerrain&("Northern winter terrain", 2800, 700, 35, 0, 700 + 350, 0, White, Snow, SlateGray, 4, 30)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Sky and Terrain: South
    gtmp = NewTerrain&("Southern desert sky", 2800, 700, 35, 0, -700 - 350, 100, RoyalBlue, SunsetOrange, Indigo, 4, 30)
    gtmp = NewTerrain&("Southern desert terrain", 2800, 700, 35, 0, -700 - 350, 0, DarkKhaki, PaleGoldenRod, Sunglow, 4, 30)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Sky and Terrain: West
    gtmp = NewTerrain&("Western desert sky", 700, 1400, 35, -700 - 350, 0, 100, RoyalBlue, DarkGray, Indigo, 4, 30)
    gtmp = NewTerrain&("Western desert terrain", 700, 1400, 35, -700 - 350, 0, 0, DarkKhaki, PaleGoldenRod, Sunglow, 4, 30)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Sky and Terrain: East
    gtmp = NewTerrain&("Eastern desert sky", 700, 1400, 35, 700 + 350, 0, 100, RoyalBlue, DarkGray, Indigo, 4, 30)
    gtmp = NewTerrain&("Eastern desert terrain", 700, 1400, 35, 700 + 350, 0, 0, DarkKhaki, PaleGoldenRod, Sunglow, 4, 30)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Snow
    FOR u = -175 TO 175 STEP 35
        FOR v = -175 TO 175 STEP 35
            IF (u * u + v * v <= 175 ^ 2) THEN
                gtmp = NewCube&(gtmp, "Snow", 15, u, v + 1050, 50, 35, 35, 100, White, Snow, SlateGray, -1)
                CALL SetParticleVelocity(gtmp, 0, 0, -.75 - RND * .25)
            END IF
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Snowman
    FOR j = 1 TO 10
        u = 5 + RND * 20
        v = 0
        x0 = RND * 2800
        y0 = RND * 700 + 700
        FOR n = 1 TO 3
            z0 = u + v
            gtmp = NewCube&(gtmp, "Snowman" + STR$(n), 300, x0, y0, z0, u * 2 / SQR(3), u * 2 / SQR(3), u * 2 / SQR(3), Teal, Cyan, DodgerBlue, -1)
            FOR k = Group(gtmp).FirstVector TO Group(gtmp).LastVector
                vec3Dvel(k, 1) = (RND - .5) * .20
                vec3Dvel(k, 2) = (RND - .5) * .20
                vec3Dvel(k, 3) = (RND - .5) * .20
            NEXT
            gtmp = NewShell&("Snowman" + STR$(n), u, x0, y0, z0, Teal, Cyan, DodgerBlue, 1, 80, -1)
            CALL ClusterPinch(gtmp)
            v = v + 2 * u
            u = u / 1.618
        NEXT
    NEXT
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Tornado
    FOR n = 1 TO 3
        u = RND * 2 * pi
        PathIndexTicker = PathIndexTicker + 1
        FOR p = 1 TO 86400
            FixedPath(PathIndexTicker, p).x = 1 * COS(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
            FixedPath(PathIndexTicker, p).y = 1 * SIN(u + 2 * pi * (24 * 60) * (p - 1) / 86400)
            FixedPath(PathIndexTicker, p).z = 0
        NEXT
        x0 = (RND - .5) * 2 * 750
        y0 = (RND - .5) * 2 * 750
        FOR k = 1 TO 30
            u = RND * 100
            v = RND * u / 3
            w = RND * 2 * pi
            gtmp = NewCube&(gtmp, "Tornado" + STR$(n), 35, x0 + v * COS(w), y0 + v * SIN(w), u, 15, 15, 15, DarkGray, SunsetOrange, DarkGoldenRod, PathIndexTicker)
            CALL SetParticleVelocity(gtmp, -SIN(w), COS(w), 0)
        NEXT
        CALL ClusterPinch(gtmp)
    NEXT
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Tree
    FOR n = 1 TO 10
        v = 30 + RND * 60
        u = v / 10
        w = u
        x0 = RND * 2800
        y0 = RND * 700 + 700
        z0 = u / 2
        FOR j = 0 TO v STEP u
            gtmp = NewCube&(gtmp, "Tree" + STR$(n), 5 * (v - j), x0, y0, z0 + j, w, w, u, Chocolate, SaddleBrown, Gray, -1)
            w = w * .9
            CALL ClusterPinch(gtmp)
        NEXT
        w = v / 1.618
        FOR j = u TO (v + 3 * u) STEP u
            gtmp = NewCube&(gtmp, "Tree" + STR$(n), 5 * (v - j), x0, y0, z0 + j, w, w, u, Lime, Green, Teal, -1)
            w = w * .8
            CALL ClusterPinch(gtmp)
        NEXT
        z0 = u / 2 + v
        gtmp = NewCube&(gtmp, "Tree" + STR$(n), 100, x0, y0, z0, u, u, u, White, Yellow, Teal, -1)
        FOR k = Group(gtmp).FirstVector TO Group(gtmp).LastVector
            vec3Dvel(k, 1) = (RND - .5) * .20
            vec3Dvel(k, 2) = (RND - .5) * .20
            vec3Dvel(k, 3) = (RND - .5) * .20
        NEXT
        CALL ClusterPinch(gtmp)
    NEXT
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ' Stellar dust
    FOR u = -1400 TO 1400 - 350 STEP 350
        FOR v = -1400 TO 1400 - 350 STEP 350
            FOR i = u TO u + 350 STEP 35
                FOR j = v TO v + 350 STEP 35
                    gtmp = NewCube&(gtmp, "Stellar dust", 15, i, j, 1350, 35, 35, 100, BlueViolet, Cyan, White, -1)
                    CALL SetParticleVelocity(gtmp, 0, 0, -.75 - RND * .25)
                NEXT
            NEXT
        NEXT
    NEXT
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    ''' Rocket
    gtmp = NewCube&(gtmp, "Rocket", 200, 0, 0, 0, 15, 15, 35, Green, Green, Green, 0)
    gtmp = NewCube&(gtmp, "Rocket", 200, 0, 0, 0, 15, 15, 15, Red, Red, Red, 0)
    Cluster(ClusterIndexTicker).Velocity.x = 0
    Cluster(ClusterIndexTicker).Velocity.y = 0
    Cluster(ClusterIndexTicker).Velocity.z = 1
    CALL ClusterPinch(gtmp)
    LOCATE 1, 1: PRINT "Loading..." + STR$(INT(100 * Group(gtmp).LastVector / bignumber)) + "%": _DISPLAY
 
    moo:
 
    'PRINT
    'PRINT "Total clusters:  " + STR$(ClusterIndexTicker)
    'PRINT "Total groups:    " + STR$(GroupIdTicker)
    'PRINT "Total particles: " + STR$(Group(gtmp).LastVector)
    '_DISPLAY
    'SLEEP 3
 
END SUB
 
SUB MainLoop
    DIM fps AS INTEGER
    DIM fpstimer AS INTEGER
    DIM tt AS INTEGER
    fps = 0
    fpstimer = INT(TIMER)
    CALL CalculateScreenVectors
    DO
        CALL PlayerDynamics
        CALL ComputeVisibleScene
        CALL PlotWorld
        CALL DisplayHUD
        CALL KeyProcess
 
        fps = fps + 1
        tt = INT(TIMER)
        IF (tt = fpstimer + 1) THEN
            fpstimer = tt
            FPSReport = fps
            fps = 0
        END IF
 
        _DISPLAY
        _LIMIT 30
    LOOP
END SUB
 
' Elevated-order primitive group.
 
FUNCTION NewPlanet& (TheRadius AS DOUBLE, ChunkSize AS DOUBLE, PosX AS DOUBLE, PosY AS DOUBLE, PosZ AS DOUBLE, TheDynamic AS INTEGER)
    DIM ShadeA AS _UNSIGNED LONG
    DIM ShadeB AS _UNSIGNED LONG
    DIM ShadeC AS _UNSIGNED LONG
    DIM gtmp AS LONG
    DIM rtemp AS DOUBLE
    DIM u AS DOUBLE
    DIM v AS DOUBLE
    DIM w AS DOUBLE
    DIM r AS DOUBLE
    FOR rtemp = ChunkSize TO TheRadius STEP ChunkSize
        FOR u = -rtemp TO rtemp STEP ChunkSize
            FOR v = -rtemp TO rtemp STEP ChunkSize
                FOR w = -rtemp TO rtemp STEP ChunkSize
                    r = SQR(u * u + v * v + w * w)
                    IF r <= rtemp AND r >= rtemp - ChunkSize THEN
                        ShadeA = ShadeMix~&(Red, SaddleBrown, r / TheRadius)
                        ShadeB = ShadeMix~&(SunsetOrange, DarkKhaki, r / TheRadius)
                        ShadeC = DarkKhaki
                        gtmp = NewCube&(1, "Planet Interior", ChunkSize, PosX + u, PosY + v, PosZ + w, ChunkSize, ChunkSize, ChunkSize, ShadeA, ShadeB, ShadeC, TheDynamic)
                        IF (r < TheRadius / 2.5) THEN
                            Group(gtmp).GroupName = "Planet center"
                            CALL SetParticleVelocity(gtmp, .25 * u / r, .25 * v / r, .25 * w / r)
                        END IF
                    END IF
                NEXT
            NEXT
        NEXT
        CALL ClusterPinch(gtmp)
    NEXT
    CALL ClusterPinch(gtmp)
    gtmp = NewShell&("Planet surface", TheRadius, PosX, PosY, PosZ, Green, DarkKhaki, DodgerBlue, 2, 20, TheDynamic)
    gtmp = NewShell&("Planet core", TheRadius / 10, PosX, PosY, PosZ, Red, Yellow, DarkGoldenRod, 2, 5, TheDynamic)
    FOR w = 0 + ChunkSize / 4 TO PosZ - TheRadius - ChunkSize / 4 STEP ChunkSize / 2
        gtmp = NewCube&(1, "Planet column", 2 * ChunkSize, PosX, PosY, w, ChunkSize / 2, ChunkSize / 2, ChunkSize / 2, Cyan, Teal, Blue, TheDynamic)
        CALL SetParticleVelocity(gtmp, .15 * (RND - .5), .15 * (RND - .5), .25 * RND)
    NEXT
    CALL ClusterPinch(gtmp)
    NewPlanet& = gtmp
END FUNCTION
 
' Medium-order primitive group(s).
 
FUNCTION NewTerrain& (TheName AS STRING, SizeX AS DOUBLE, SizeY AS DOUBLE, TheResolution AS DOUBLE, PosX AS DOUBLE, PosY AS DOUBLE, PosZ AS DOUBLE, ShadeA AS _UNSIGNED LONG, ShadeB AS _UNSIGNED LONG, ShadeC AS _UNSIGNED LONG, BumpFactor AS DOUBLE, SmoothFactor AS INTEGER)
    DIM g AS LONG
    DIM q AS LONG
    DIM vindex AS LONG
    DIM k AS INTEGER
    DIM factor1 AS DOUBLE
    DIM factor2 AS DOUBLE
    DIM a AS DOUBLE
    DIM b AS DOUBLE
    DIM i AS DOUBLE
    DIM j AS DOUBLE
    DIM u AS DOUBLE
    DIM v AS DOUBLE
    DIM w AS DOUBLE
    DIM ia AS DOUBLE
    DIM jb AS DOUBLE
    DIM rr AS DOUBLE
    DIM wi AS INTEGER
    DIM wj AS INTEGER
    DIM wa AS INTEGER
    DIM wb AS INTEGER
    DIM ci AS INTEGER
    DIM cj AS INTEGER
    DIM ca AS INTEGER
    DIM cb AS INTEGER
 
    factor1 = TheResolution
    factor2 = factor1 / 10
    wi = 0
    wj = 0
    wa = 0
    wb = 0
    FOR i = -SizeX / 2 + factor1 / 2 TO SizeX / 2 - factor1 / 2 STEP factor1
        wi = wi + 1
    NEXT
    FOR j = -SizeY / 2 + factor1 / 2 TO SizeY / 2 - factor1 / 2 STEP factor1
        wj = wj + 1
    NEXT
    FOR a = 0 TO factor1 - 0 * factor2 STEP factor2
        wa = wa + 1
    NEXT
    FOR b = 0 TO factor1 - 0 * factor2 STEP factor2
        wb = wb + 1
    NEXT
 
    DIM vgrid(wi * wa, wj * wb, 2) AS DOUBLE
    DIM vgrid2(wi * wa, wj * wb) AS DOUBLE
    FOR ia = 1 TO wi * wa
        FOR jb = 1 TO wj * wb
            SELECT CASE (RND)
                CASE IS < .005
                    vgrid(ia, jb, 1) = factor1 * RND
                    vgrid(ia, jb, 2) = 1
                CASE IS > 1 - .005
                    vgrid(ia, jb, 1) = -factor1 * RND / 2
                    vgrid(ia, jb, 2) = 1
                CASE ELSE
                    vgrid(ia, jb, 1) = 0
                    vgrid(ia, jb, 2) = 0
            END SELECT
        NEXT
    NEXT
 
    IF (SmoothFactor > 0) THEN
        FOR k = 1 TO SmoothFactor
            FOR ia = 1 TO wi * wa
                FOR jb = 1 TO wj * wb
                    vgrid2(ia, jb) = vgrid(ia, jb, 1)
                NEXT
            NEXT
            FOR ia = 1 + 1 TO wi * wa - 1
                FOR jb = 1 + 1 TO wj * wb - 1
                    IF (k = SmoothFactor - 5) THEN
                        vgrid(ia, jb, 2) = 0
                    END IF
                    IF vgrid(ia, jb, 2) = 0 THEN
                        vgrid(ia, jb, 1) = (1 / 4) * (vgrid2(ia - 1, jb) + vgrid2(ia + 1, jb) + vgrid2(ia, jb - 1) + vgrid2(ia, jb + 1))
                    END IF
                NEXT
            NEXT
        NEXT
    END IF
 
    ci = 0
    cj = 0
    ca = 0
    cb = 0
    g = 1
    FOR i = -SizeX / 2 + factor1 / 2 - TheResolution / 2 TO SizeX / 2 - factor1 / 2 - TheResolution / 2 STEP factor1
        ci = ci + 1
        cj = 0
        FOR j = -SizeY / 2 + factor1 / 2 - TheResolution / 2 TO SizeY / 2 - factor1 / 2 - TheResolution / 2 STEP factor1
            cj = cj + 1
            u = i
            v = j
            w = 0
            q = LatestIdentity&(g)
            vindex = Group(q).LastVector
            g = CreateNewGroup&(q, PosX + u, PosY + v, PosZ + w, 0, 24)
            Group(g).GroupName = TheName
            Group(g).Volume.x = SizeX
            Group(g).Volume.y = SizeY
            Group(g).Volume.z = SQR(SizeX * SizeX + SizeY * SizeY)
            Group(g).FirstVector = vindex + 1
            ca = 0
            FOR a = i TO i + factor1 - 0 * factor2 STEP factor2
                ca = ca + 1
                cb = 0
                FOR b = j TO j + factor1 - 0 * factor2 STEP factor2
                    cb = cb + 1
                    rr = vgrid((ci - 1) * wa + ca, (cj - 1) * wb + cb, 1)
                    vindex = vindex + 1
                    vec3Dpos(vindex, 1) = -u + a + BumpFactor * (RND - .5)
                    vec3Dpos(vindex, 2) = -v + b + BumpFactor * (RND - .5)
                    vec3Dpos(vindex, 3) = -w + rr + BumpFactor * (RND - .5)
                    IF (rr > 0) THEN
                        vec3Dcolor(vindex) = ShadeMix~&(ShadeA, ShadeB, rr / 10)
                    ELSE
                        vec3Dcolor(vindex) = ShadeC
                    END IF
                NEXT
            NEXT
            Group(g).LastVector = vindex
        NEXT
        CALL ClusterPinch(g)
    NEXT
    CALL ClusterPinch(g)
    NewTerrain& = g
END FUNCTION
 
FUNCTION NewShell& (TheName AS STRING, TheRadius AS DOUBLE, PosX AS DOUBLE, PosY AS DOUBLE, PosZ AS DOUBLE, ShadeA AS _UNSIGNED LONG, ShadeB AS _UNSIGNED LONG, ShadeC AS _UNSIGNED LONG, BumpFactor AS DOUBLE, SmoothFactor AS INTEGER, TheDynamic AS INTEGER)
    DIM g AS LONG
    DIM q AS LONG
    DIM vindex AS LONG
    DIM k AS INTEGER
    DIM factor1 AS DOUBLE
    DIM factor2 AS DOUBLE
    DIM a AS DOUBLE
    DIM b AS DOUBLE
    DIM i AS DOUBLE
    DIM j AS DOUBLE
    DIM u AS DOUBLE
    DIM v AS DOUBLE
    DIM w AS DOUBLE
    DIM ia AS DOUBLE
    DIM jb AS DOUBLE
    DIM rr AS DOUBLE
    DIM wi AS LONG
    DIM wj AS LONG
    DIM wa AS LONG
    DIM wb AS LONG
    DIM ci AS LONG
    DIM cj AS LONG
    DIM ca AS LONG
    DIM cb AS LONG
 
    IF (TheRadius > 200) THEN
        factor1 = (2) * 2 * pi / (10 ^ (INT(LOG(TheRadius) / LOG(10))))
        factor2 = factor1 / (10)
    ELSE
        factor1 = 2 * pi / (10)
        factor2 = factor1 / (5)
    END IF
 
 
    wi = 0
    wj = 0
    wa = 0
    wb = 0
    FOR i = 0 TO 2 * pi - factor1 STEP factor1
        wi = wi + 1
    NEXT
    FOR j = factor2 TO pi - 0 STEP factor1
        wj = wj + 1
    NEXT
    FOR a = 0 TO factor1 STEP factor2
        wa = wa + 1
    NEXT
    FOR b = 0 TO factor1 STEP factor2
        wb = wb + 1
    NEXT
 
    DIM vgrid(wi * wa, wj * wb, 2) AS DOUBLE
    DIM vgrid2(wi * wa, wj * wb) AS DOUBLE
 
    FOR ia = 1 TO wi * wa
        FOR jb = 1 TO wj * wb
            SELECT CASE (RND)
                CASE IS < .025
                    vgrid(ia, jb, 1) = TheRadius - BumpFactor * (TheRadius / 50)
                    vgrid(ia, jb, 2) = 1
                CASE IS > 1 - .025
                    vgrid(ia, jb, 1) = TheRadius + BumpFactor * (TheRadius / 50)
                    vgrid(ia, jb, 2) = 1
                CASE ELSE
                    vgrid(ia, jb, 1) = TheRadius
                    vgrid(ia, jb, 2) = 0
            END SELECT
        NEXT
    NEXT
 
    IF (SmoothFactor > 0) THEN
        FOR k = 1 TO SmoothFactor
            FOR ia = 1 TO wi * wa
                FOR jb = 1 TO wj * wb
                    vgrid2(ia, jb) = vgrid(ia, jb, 1)
                NEXT
            NEXT
            FOR ia = 1 + 1 TO wi * wa - 1
                FOR jb = 1 + 1 TO wj * wb - 1
                    IF (k = SmoothFactor - 5) THEN
                        vgrid(ia, jb, 2) = 0
                    END IF
                    IF vgrid(ia, jb, 2) = 0 THEN
                        vgrid(ia, jb, 1) = (1 / 4) * (vgrid2(ia - 1, jb) + vgrid2(ia + 1, jb) + vgrid2(ia, jb - 1) + vgrid2(ia, jb + 1))
                    END IF
                NEXT
            NEXT
        NEXT
    END IF
 
    ci = 0
    cj = 0
    ca = 0
    cb = 0
    g = 1
    FOR i = 0 TO 2 * pi - factor1 STEP factor1
        ci = ci + 1
        cj = 0
        FOR j = factor2 TO pi - 0 STEP factor1
            cj = cj + 1
            u = TheRadius * SIN(j) * COS(i)
            v = TheRadius * SIN(j) * SIN(i)
            w = TheRadius * COS(j)
            q = LatestIdentity&(g)
            vindex = Group(q).LastVector
            g = CreateNewGroup&(q, PosX + u, PosY + v, PosZ + w, TheDynamic, 64)
            Group(g).GroupName = TheName
            Group(g).Volume.x = TheRadius
            Group(g).Volume.y = TheRadius
            Group(g).Volume.z = TheRadius
            Group(g).FirstVector = vindex + 1
            ca = 0
            FOR a = i TO i + factor1 STEP factor2
                ca = ca + 1
                cb = 0
                FOR b = j TO j + factor1 STEP factor2
                    cb = cb + 1
                    rr = vgrid((ci - 1) * wa + ca, (cj - 1) * wb + cb, 1)
                    vindex = vindex + 1
                    vec3Dpos(vindex, 1) = -u + rr * SIN(b) * COS(a) + BumpFactor * (RND - .5) * 2
                    vec3Dpos(vindex, 2) = -v + rr * SIN(b) * SIN(a) + BumpFactor * (RND - .5) * 2
                    vec3Dpos(vindex, 3) = -w + rr * COS(b) + BumpFactor * (RND - .5) * 2
                    IF (rr > TheRadius) THEN
                        vec3Dcolor(vindex) = ShadeMix~&(ShadeA, ShadeB, COS(j) ^ 2)
                    ELSE
                        vec3Dcolor(vindex) = ShadeC
                    END IF
                NEXT
            NEXT
            Group(g).LastVector = vindex
        NEXT
        CALL ClusterPinch(g)
    NEXT
    CALL ClusterPinch(g)
 
    NewShell& = g
END SUB
 
' Low-order primitive group(s).
 
FUNCTION NewCube& (StartingIdentity AS LONG, TheName AS STRING, Weight AS INTEGER, PosX AS DOUBLE, PosY AS DOUBLE, PosZ AS DOUBLE, VolX AS DOUBLE, VolY AS DOUBLE, VolZ AS DOUBLE, ShadeA AS _UNSIGNED LONG, ShadeB AS _UNSIGNED LONG, ShadeC AS _UNSIGNED LONG, TheDynamic AS INTEGER)
    DIM k AS INTEGER
    DIM g AS LONG
    DIM q AS LONG
    DIM vindex AS LONG
    q = LatestIdentity&(StartingIdentity)
    vindex = Group(q).LastVector
    g = CreateNewGroup(q, PosX, PosY, PosZ, TheDynamic, 64)
    Group(g).GroupName = TheName
    Group(g).Volume.x = VolX
    Group(g).Volume.y = VolY
    Group(g).Volume.z = VolZ
    Group(g).FirstVector = vindex + 1
    FOR k = 1 TO Weight
        vindex = vindex + 1
        vec3Dpos(vindex, 1) = (RND - .5) * VolX
        vec3Dpos(vindex, 2) = (RND - .5) * VolY
        vec3Dpos(vindex, 3) = (RND - .5) * VolZ
        IF (RND > .5) THEN
            vec3Dcolor(vindex) = ShadeA
        ELSE
            IF (RND > .5) THEN
                vec3Dcolor(vindex) = ShadeB
            ELSE
                vec3Dcolor(vindex) = ShadeC
            END IF
        END IF
    NEXT
    Group(g).LastVector = vindex
    NewCube& = g
END FUNCTION
 
' Linked list utility.
 
FUNCTION LatestIdentity& (StartingID AS LONG)
    DIM TheReturn AS LONG
    DIM p AS LONG
    DIM q AS LONG
    p = StartingID
    DO
        q = p
        p = Group(q).Pointer
        IF (p = -999) THEN EXIT DO
    LOOP
    TheReturn = q
    LatestIdentity& = TheReturn
END FUNCTION
 
FUNCTION CreateNewGroup& (TheLaggerIn AS LONG, CenterX AS DOUBLE, CenterY AS DOUBLE, CenterZ AS DOUBLE, TheDynamic AS INTEGER, ClusterSize AS INTEGER)
    GroupIdTicker = GroupIdTicker + 1
    Group(GroupIdTicker).Identity = GroupIdTicker
    Group(GroupIdTicker).Pointer = -999
    Group(GroupIdTicker).Lagger = TheLaggerIn
    Group(GroupIdTicker).Centroid.x = CenterX
    Group(GroupIdTicker).Centroid.y = CenterY
    Group(GroupIdTicker).Centroid.z = CenterZ
    IF (TheLaggerIn <> 0) THEN
        Group(TheLaggerIn).Pointer = Group(GroupIdTicker).Identity
    END IF
    '''
    ClusterFillCounter = ClusterFillCounter + 1
 
    IF (ClusterFillCounter = 1) THEN
        ClusterIndexTicker = ClusterIndexTicker + 1
        Cluster(ClusterIndexTicker).FirstGroup = Group(GroupIdTicker).Identity
        Cluster(ClusterIndexTicker).MotionType = TheDynamic
    END IF
 
    IF (ClusterFillCounter = ClusterSize) THEN
        CALL ClusterPinch(Group(GroupIdTicker).Identity)
    END IF
    '''
    CreateNewGroup& = Group(GroupIdTicker).Identity
END FUNCTION
 
SUB ClusterPinch (TheLastGroup AS LONG)
    ClusterFillCounter = 0
    Cluster(ClusterIndexTicker).LastGroup = TheLastGroup
    CALL ClusterCentroidCalc(ClusterIndexTicker)
END SUB
 
SUB ClusterCentroidCalc (TheClusterIndex AS LONG)
    DIM k AS LONG
    DIM n AS INTEGER
    Cluster(TheClusterIndex).Centroid.x = 0
    Cluster(TheClusterIndex).Centroid.y = 0
    Cluster(TheClusterIndex).Centroid.z = 0
    k = Cluster(TheClusterIndex).FirstGroup
    n = 0
    DO
        Cluster(TheClusterIndex).Centroid.x = Cluster(TheClusterIndex).Centroid.x + Group(k).Centroid.x
        Cluster(TheClusterIndex).Centroid.y = Cluster(TheClusterIndex).Centroid.y + Group(k).Centroid.y
        Cluster(TheClusterIndex).Centroid.z = Cluster(TheClusterIndex).Centroid.z + Group(k).Centroid.z
        n = n + 1
        IF (k = Cluster(TheClusterIndex).LastGroup) THEN EXIT DO
        k = Group(k).Pointer
    LOOP
    Cluster(TheClusterIndex).Centroid.x = Cluster(TheClusterIndex).Centroid.x / n
    Cluster(TheClusterIndex).Centroid.y = Cluster(TheClusterIndex).Centroid.y / n
    Cluster(TheClusterIndex).Centroid.z = Cluster(TheClusterIndex).Centroid.z / n
END SUB
 
' Vector manipulation.
 
SUB SetParticleVelocity (TheGroup AS LONG, vx AS DOUBLE, vy AS DOUBLE, vz AS DOUBLE)
    DIM j AS LONG
    DIM m AS LONG
    DIM n AS LONG
    m = Group(TheGroup).FirstVector
    n = Group(TheGroup).LastVector
    FOR j = m TO n
        vec3Dvel(j, 1) = vx
        vec3Dvel(j, 2) = vy
        vec3Dvel(j, 3) = vz
    NEXT
END SUB
 
' Cluster manipulation.
 
SUB EvolveCluster (TheClusterIndex AS LONG)
    DIM dx, dy, dz, t, u, v AS DOUBLE
    IF (Cluster(TheClusterIndex).MotionType = 0) THEN
        dx = Cluster(TheClusterIndex).Velocity.x
        dy = Cluster(TheClusterIndex).Velocity.y
        dz = Cluster(TheClusterIndex).Velocity.z
    ELSE
        t = TIMER
        u = INT(t)
        v = t - u
        dx = v * FixedPath(Cluster(TheClusterIndex).MotionType, u).x + (1 - v) * FixedPath(Cluster(TheClusterIndex).MotionType, u - 1).x
        dy = v * FixedPath(Cluster(TheClusterIndex).MotionType, u).y + (1 - v) * FixedPath(Cluster(TheClusterIndex).MotionType, u - 1).y
        dz = v * FixedPath(Cluster(TheClusterIndex).MotionType, u).z + (1 - v) * FixedPath(Cluster(TheClusterIndex).MotionType, u - 1).z
    END IF
    IF ((dx <> 0) OR (dy <> 0) OR (dz <> 0)) THEN
        CALL TranslateCluster(TheClusterIndex, dx, dy, dz)
    END IF
END SUB
 
SUB TranslateCluster (TheClusterIndex AS LONG, dx AS DOUBLE, dy AS DOUBLE, dz AS DOUBLE)
    DIM k AS LONG
    k = Cluster(TheClusterIndex).FirstGroup
    DO
        Group(k).Centroid.x = Group(k).Centroid.x + dx
        Group(k).Centroid.y = Group(k).Centroid.y + dy
        Group(k).Centroid.z = Group(k).Centroid.z + dz
        IF (k = Cluster(TheClusterIndex).LastGroup) THEN EXIT DO
        k = Group(k).Pointer
    LOOP
    Cluster(TheClusterIndex).Centroid.x = Cluster(TheClusterIndex).Centroid.x + dx
    Cluster(TheClusterIndex).Centroid.y = Cluster(TheClusterIndex).Centroid.y + dy
    Cluster(TheClusterIndex).Centroid.z = Cluster(TheClusterIndex).Centroid.z + dz
END SUB
 
' Particle manipulation.
 
SUB EvolveParticles (TheGroup AS LONG)
    DIM xdim AS DOUBLE
    DIM ydim AS DOUBLE
    DIM zdim AS DOUBLE
    DIM dx AS DOUBLE
    DIM dy AS DOUBLE
    DIM dz AS DOUBLE
    DIM px AS DOUBLE
    DIM py AS DOUBLE
    DIM pz AS DOUBLE
    DIM k AS LONG
 
    xdim = Group(TheGroup).Volume.x
    ydim = Group(TheGroup).Volume.y
    zdim = Group(TheGroup).Volume.z
 
    FOR k = Group(TheGroup).FirstVector TO Group(TheGroup).LastVector
 
        ' Position update with periodic boundaries inside group volume
        dx = 1 * vec3Dvel(k, 1)
        dy = 1 * vec3Dvel(k, 2)
        dz = 1 * vec3Dvel(k, 3)
        IF (dx <> 0) THEN
            px = vec3Dpos(k, 1) + dx
            IF ABS(px) > xdim / 2 THEN
                IF (px > xdim / 2) THEN
                    px = -xdim / 2
                ELSE
                    px = xdim / 2
                END IF
            END IF
            vec3Dpos(k, 1) = px
        END IF
        IF (dy <> 0) THEN
            py = vec3Dpos(k, 2) + dy
            IF ABS(py) > ydim / 2 THEN
                IF (py > ydim / 2) THEN
                    py = -ydim / 2
                ELSE
                    py = ydim / 2
                END IF
            END IF
            vec3Dpos(k, 2) = py
        END IF
        IF (dz <> 0) THEN
            pz = vec3Dpos(k, 3) + dz
            IF ABS(pz) > zdim / 2 THEN
                IF (pz > zdim / 2) THEN
                    pz = -zdim / 2
                ELSE
                    pz = zdim / 2
                END IF
            END IF
            vec3Dpos(k, 3) = pz
        END IF
    NEXT
END SUB
 
SUB CalculateScreenVectors
    DIM uhatmag AS DOUBLE
    DIM vhatmag AS DOUBLE
    DIM h2 AS DOUBLE
    DIM w2 AS DOUBLE
    DIM mag AS DOUBLE
    DIM uhatdotvhat AS DOUBLE
    uhatmag = SQR(uhat(1) * uhat(1) + uhat(2) * uhat(2) + uhat(3) * uhat(3))
    uhat(1) = uhat(1) / uhatmag: uhat(2) = uhat(2) / uhatmag: uhat(3) = uhat(3) / uhatmag
    vhatmag = SQR(vhat(1) * vhat(1) + vhat(2) * vhat(2) + vhat(3) * vhat(3))
    vhat(1) = vhat(1) / vhatmag: vhat(2) = vhat(2) / vhatmag: vhat(3) = vhat(3) / vhatmag
    uhatdotvhat = uhat(1) * vhat(1) + uhat(2) * vhat(2) + uhat(3) * vhat(3)
    nhat(1) = uhat(2) * vhat(3) - uhat(3) * vhat(2)
    nhat(2) = uhat(3) * vhat(1) - uhat(1) * vhat(3)
    nhat(3) = uhat(1) * vhat(2) - uhat(2) * vhat(1)
    h2 = _HEIGHT / 2
    w2 = _WIDTH / 2
    nearplane(1) = -nhat(1)
    nearplane(2) = -nhat(2)
    nearplane(3) = -nhat(3)
    farplane(1) = nhat(1)
    farplane(2) = nhat(2)
    farplane(3) = nhat(3)
    rightplane(1) = h2 * fovd * uhat(1) - h2 * w2 * nhat(1)
    rightplane(2) = h2 * fovd * uhat(2) - h2 * w2 * nhat(2)
    rightplane(3) = h2 * fovd * uhat(3) - h2 * w2 * nhat(3)
    mag = SQR(rightplane(1) * rightplane(1) + rightplane(2) * rightplane(2) + rightplane(3) * rightplane(3))
    rightplane(1) = rightplane(1) / mag
    rightplane(2) = rightplane(2) / mag
    rightplane(3) = rightplane(3) / mag
    leftplane(1) = -h2 * fovd * uhat(1) - h2 * w2 * nhat(1)
    leftplane(2) = -h2 * fovd * uhat(2) - h2 * w2 * nhat(2)
    leftplane(3) = -h2 * fovd * uhat(3) - h2 * w2 * nhat(3)
    mag = SQR(leftplane(1) * leftplane(1) + leftplane(2) * leftplane(2) + leftplane(3) * leftplane(3))
    leftplane(1) = leftplane(1) / mag
    leftplane(2) = leftplane(2) / mag
    leftplane(3) = leftplane(3) / mag
    topplane(1) = w2 * fovd * vhat(1) - h2 * w2 * nhat(1)
    topplane(2) = w2 * fovd * vhat(2) - h2 * w2 * nhat(2)
    topplane(3) = w2 * fovd * vhat(3) - h2 * w2 * nhat(3)
    mag = SQR(topplane(1) * topplane(1) + topplane(2) * topplane(2) + topplane(3) * topplane(3))
    topplane(1) = topplane(1) / mag
    topplane(2) = topplane(2) / mag
    topplane(3) = topplane(3) / mag
    bottomplane(1) = -w2 * fovd * vhat(1) - h2 * w2 * nhat(1)
    bottomplane(2) = -w2 * fovd * vhat(2) - h2 * w2 * nhat(2)
    bottomplane(3) = -w2 * fovd * vhat(3) - h2 * w2 * nhat(3)
    mag = SQR(bottomplane(1) * bottomplane(1) + bottomplane(2) * bottomplane(2) + bottomplane(3) * bottomplane(3))
    bottomplane(1) = bottomplane(1) / mag
    bottomplane(2) = bottomplane(2) / mag
    bottomplane(3) = bottomplane(3) / mag
END SUB
 
SUB ProjectGroup (TheGroup AS LONG)
    DIM i AS LONG
    DIM f AS INTEGER
    DIM vectorinview AS INTEGER
    DIM vec3Ddotnhat AS DOUBLE
    FOR i = Group(TheGroup).FirstVector TO Group(TheGroup).LastVector
        vec(i, 1) = Group(TheGroup).Centroid.x + vec3Dpos(i, 1) - PlayerCamera.Position.x
        vec(i, 2) = Group(TheGroup).Centroid.y + vec3Dpos(i, 2) - PlayerCamera.Position.y
        vec(i, 3) = Group(TheGroup).Centroid.z + vec3Dpos(i, 3) - PlayerCamera.Position.z
        f = -1
        vec3Dvis(i) = 0
        vectorinview = 1
        IF vec(i, 1) * nearplane(1) + vec(i, 2) * nearplane(2) + vec(i, 3) * nearplane(3) - nearplane(4) < 0 THEN vectorinview = 0
        'IF vec(i, 1) * farplane(1) + vec(i, 2) * farplane(2) + vec(i, 3) * farplane(3) - farplane(4) < 0 THEN vectorinview = 0
        IF vec(i, 1) * farplane(1) + vec(i, 2) * farplane(2) + vec(i, 3) * farplane(3) - farplane(4) * .85 < 0 THEN f = 1
        'IF vec(i, 1) * rightplane(1) + vec(i, 2) * rightplane(2) + vec(i, 3) * rightplane(3) - rightplane(4) < 0 THEN vectorinview = 0
        'IF vec(i, 1) * leftplane(1) + vec(i, 2) * leftplane(2) + vec(i, 3) * leftplane(3) - leftplane(4) < 0 THEN vectorinview = 0
        'IF vec(i, 1) * topplane(1) + vec(i, 2) * topplane(2) + vec(i, 3) * topplane(3) - topplane(4) < 0 THEN vectorinview = 0
        'IF vec(i, 1) * bottomplane(1) + vec(i, 2) * bottomplane(2) + vec(i, 3) * bottomplane(3) - bottomplane(4) < 0 THEN vectorinview = 0
        IF (vectorinview = 1) THEN
            vec3Dvis(i) = 1
            vec3Ddotnhat = vec(i, 1) * nhat(1) + vec(i, 2) * nhat(2) + vec(i, 3) * nhat(3)
            vec2D(i, 1) = (vec(i, 1) * uhat(1) + vec(i, 2) * uhat(2) + vec(i, 3) * uhat(3)) * fovd / vec3Ddotnhat
            vec2D(i, 2) = (vec(i, 1) * vhat(1) + vec(i, 2) * vhat(2) + vec(i, 3) * vhat(3)) * fovd / vec3Ddotnhat
            IF (f = 1) THEN
                vec2Dcolor(i) = Gray
            ELSE
                vec2Dcolor(i) = vec3Dcolor(i)
            END IF
        END IF
    NEXT
END SUB
 
' TheDynamics
 
SUB ComputeVisibleScene
    DIM closestdist2 AS DOUBLE
    DIM fp42 AS DOUBLE
    DIM dist2 AS DOUBLE
    DIM dx AS DOUBLE
    DIM dy AS DOUBLE
    DIM dz AS DOUBLE
    DIM GroupInView AS INTEGER
    DIM k AS LONG
    DIM i AS LONG
    ClosestGroup = 1
    closestdist2 = 10000000
    fp42 = farplane(4) * farplane(4)
    FOR i = 1 TO ClusterIndexTicker
        dx = Cluster(i).Centroid.x - PlayerCamera.Position.x
        dy = Cluster(i).Centroid.y - PlayerCamera.Position.y
        dz = Cluster(i).Centroid.z - PlayerCamera.Position.z
        dist2 = dx * dx + dy * dy + dz * dz
        IF (dist2 > 600 * 600) THEN
            Cluster(i).Visible = 0
            IF (Cluster(i).MotionType > -1) THEN
                CALL EvolveCluster(i)
            END IF
        ELSE
            Cluster(i).Visible = 1
            k = Cluster(i).FirstGroup
            IF ((Cluster(i).MotionType > -1) AND (ToggleAnimate = 1)) THEN
                CALL EvolveCluster(i)
            END IF
            DO
                dx = Group(k).Centroid.x - PlayerCamera.Position.x
                dy = Group(k).Centroid.y - PlayerCamera.Position.y
                dz = Group(k).Centroid.z - PlayerCamera.Position.z
                dist2 = dx * dx + dy * dy + dz * dz
                Group(k).Visible = 0
                IF (dist2 < fp42) THEN
                    GroupInView = 1
                    IF dx * nearplane(1) + dy * nearplane(2) + dz * nearplane(3) - nearplane(4) < 0 THEN GroupInView = 0
                    'IF dx * farplane(1) + dy * farplane(2) + dz * farplane(3) - farplane(4) < 0 THEN groupinview = 0 ''' Redundant
                    IF dx * rightplane(1) + dy * rightplane(2) + dz * rightplane(3) - rightplane(4) < 0 THEN GroupInView = 0
                    IF dx * leftplane(1) + dy * leftplane(2) + dz * leftplane(3) - leftplane(4) < 0 THEN GroupInView = 0
                    IF dx * topplane(1) + dy * topplane(2) + dz * topplane(3) - topplane(4) < 0 THEN GroupInView = 0
                    IF dx * bottomplane(1) + dy * bottomplane(2) + dz * bottomplane(3) - bottomplane(4) < 0 THEN GroupInView = 0
                    IF (GroupInView = 1) THEN
                        Group(k).Visible = 1
                        IF (dist2 < closestdist2) THEN
                            closestdist2 = dist2
                            ClosestGroup = k
                        END IF
                        Group(k).Distance2 = dist2
                        IF (ToggleAnimate = 1) THEN CALL EvolveParticles(k)
                        CALL ProjectGroup(k)
                    END IF
                END IF
                IF (k = Cluster(i).LastGroup) THEN EXIT DO
                k = Group(k).Pointer
            LOOP
        END IF
    NEXT
END SUB
 
' Graphics
 
SUB PlotWorld
    DIM a AS DOUBLE
    DIM b AS DOUBLE
    DIM c AS LONG
    DIM d AS LONG
    DIM i AS LONG
    DIM j AS INTEGER
    DIM k AS LONG
    DIM x1 AS DOUBLE
    DIM y1 AS DOUBLE
    DIM x2 AS DOUBLE
    DIM y2 AS DOUBLE
    DIM clrtmp AS _UNSIGNED LONG
    DIM SortedGroups(5000) AS LONG
    DIM SortedGroupsCount AS INTEGER
 
    NumClusterVisible = 0
    NumVectorVisible = 0
 
    SortedGroupsCount = 0
    FOR i = 1 TO ClusterIndexTicker
        IF (Cluster(i).Visible = 1) THEN
            NumClusterVisible = NumClusterVisible + 1
            k = Cluster(i).FirstGroup
            DO
                IF (Group(k).Visible = 1) THEN
                    SortedGroupsCount = SortedGroupsCount + 1
                    SortedGroups(SortedGroupsCount) = k
                END IF
                IF (k = Cluster(i).LastGroup) THEN EXIT DO
                k = Group(k).Pointer
            LOOP
        END IF
    NEXT
 
    NumGroupVisible = SortedGroupsCount
 
    ' Bubble sort might be a shitty choice but it works for now. Replace with quicksort prolly.
    FOR j = SortedGroupsCount TO 1 STEP -1
        FOR i = 2 TO SortedGroupsCount
            a = Group(SortedGroups(i - 1)).Distance2
            b = Group(SortedGroups(i)).Distance2
            IF (a < b) THEN
                c = SortedGroups(i - 1)
                d = SortedGroups(i)
                SortedGroups(i - 1) = d
                SortedGroups(i) = c
            END IF
        NEXT
    NEXT
 
    CLS
    PlayerCamera.Shade = ShadeMix~&(PlayerCamera.Shade, vec3Dcolor(Group(ClosestGroup).FirstVector), .01)
    PAINT (_WIDTH / 2, _HEIGHT / 2), _RGBA(_RED32(PlayerCamera.Shade), _GREEN32(PlayerCamera.Shade), _BLUE32(PlayerCamera.Shade), 100)
    FOR j = 1 TO SortedGroupsCount
        k = SortedGroups(j)
        FOR i = Group(k).FirstVector TO Group(k).LastVector - 1
            IF (vec3Dvis(i) = 1) THEN
                NumVectorVisible = NumVectorVisible + 1
                IF (k = ClosestGroup) THEN
                    clrtmp = Yellow
                ELSE
                    clrtmp = vec2Dcolor(i)
                END IF
                x1 = vec2D(i, 1)
                y1 = vec2D(i, 2)
                x2 = vec2D(i + 1, 1)
                y2 = vec2D(i + 1, 2)
                IF (((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) < 225) THEN
                    CALL cline(x1, y1, x2, y2, clrtmp) 'lineSmooth
                ELSE
                    CALL ccircle(x1, y1, 1, clrtmp)
                END IF
            END IF
        NEXT
    NEXT
END SUB
 
SUB DisplayHUD
    DIM a AS STRING
    DIM k AS INTEGER
    CALL lineSmooth(0, 0, 25 * (xhat(1) * uhat(1) + xhat(2) * uhat(2) + xhat(3) * uhat(3)), 25 * (xhat(1) * vhat(1) + xhat(2) * vhat(2) + xhat(3) * vhat(3)), _RGBA(255, 0, 0, 200))
    CALL lineSmooth(0, 0, 25 * (yhat(1) * uhat(1) + yhat(2) * uhat(2) + yhat(3) * uhat(3)), 25 * (yhat(1) * vhat(1) + yhat(2) * vhat(2) + yhat(3) * vhat(3)), _RGBA(0, 255, 0, 200))
    CALL lineSmooth(0, 0, 25 * (zhat(1) * uhat(1) + zhat(2) * uhat(2) + zhat(3) * uhat(3)), 25 * (zhat(1) * vhat(1) + zhat(2) * vhat(2) + zhat(3) * vhat(3)), _RGBA(30, 144, 255, 200))
    IF (ToggleHUD = 1) THEN
        COLOR LimeGreen
        _PRINTSTRING ((1) * 8, _HEIGHT - (10) * 16), " Position "
        COLOR Teal
        _PRINTSTRING ((1) * 8, _HEIGHT - (9) * 16), " x:       "
        _PRINTSTRING ((1) * 8, _HEIGHT - (8) * 16), " y:       "
        _PRINTSTRING ((1) * 8, _HEIGHT - (7) * 16), " z:       "
        _PRINTSTRING ((1) * 8, _HEIGHT - (9) * 16), " x: " + LTRIM$(RTRIM$(STR$(INT(PlayerCamera.Position.x))))
        _PRINTSTRING ((1) * 8, _HEIGHT - (8) * 16), " y: " + LTRIM$(RTRIM$(STR$(INT(PlayerCamera.Position.y))))
        _PRINTSTRING ((1) * 8, _HEIGHT - (7) * 16), " z: " + LTRIM$(RTRIM$(STR$(INT(PlayerCamera.Position.z))))
        COLOR LimeGreen
        _PRINTSTRING ((1) * 8, _HEIGHT - (6) * 16), " O: Reset "
        COLOR LimeGreen
        _PRINTSTRING ((1) * 8, _HEIGHT - (4) * 16), " Move  "
        COLOR DarkKhaki
        _PRINTSTRING ((1) * 8, _HEIGHT - (3) * 16), " q W e "
        _PRINTSTRING ((1) * 8, _HEIGHT - (2) * 16), " A S D "
        COLOR LimeGreen
        _PRINTSTRING ((1) * 8, (1) * 16), " Abilities "
        COLOR DarkKhaki
        _PRINTSTRING ((1) * 8, (2) * 16), "t = Pause  "
        _PRINTSTRING ((1) * 8, (3) * 16), "b = Create "
        _PRINTSTRING ((1) * 8, (4) * 16), "n = Explode"
        COLOR DarkGray
        _PRINTSTRING ((1) * 8, (5) * 16), "k = Delete "
        COLOR DarkKhaki
        _PRINTSTRING ((1) * 8, (6) * 16), "Esc = Quit "
        'COLOR LimeGreen
        '_PRINTSTRING ((1) * 8, (9) * 16), "View"
        'COLOR DarkKhaki
        '_PRINTSTRING ((1) * 8, (9) * 16), "FPS: " + LTRIM$(RTRIM$(STR$(FPSReport))) + "/30"
        '_PRINTSTRING ((1) * 8, (10) * 16), "Clusters: " + LTRIM$(RTRIM$(STR$(NumClusterVisible)))
        '_PRINTSTRING ((1) * 8, (11) * 16), "Groups: " + LTRIM$(RTRIM$(STR$(NumGroupVisible)))
        '_PRINTSTRING ((1) * 8, (12) * 16), "Particles: " + LTRIM$(RTRIM$(STR$(NumVectorVisible)))
        COLOR LimeGreen
        _PRINTSTRING (_WIDTH - (12) * 8, (1) * 16), " Locations "
        FOR k = 1 TO MissionTicker
            a = " " + Mission(k).Label + " "
            IF (Mission(k).Discovered = 0) THEN
                COLOR DarkKhaki
            ELSE
                COLOR DarkGray
            END IF
            _PRINTSTRING (_WIDTH - (LEN(a) + 1) * 8, (1 + k) * 16), a
        NEXT
        COLOR LimeGreen
        _PRINTSTRING (_WIDTH - (12) * 8, (k + 1) * 16), " M = Reset "
        COLOR LimeGreen
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (10) * 16), " Aim    "
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (9) * 16), " x      "
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (8) * 16), " y      "
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (7) * 16), " z      "
        COLOR Teal
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (9) * 16), " x: " + LTRIM$(RTRIM$(STR$(INT(-nhat(1) * 100))))
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (8) * 16), " y: " + LTRIM$(RTRIM$(STR$(INT(-nhat(2) * 100))))
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (7) * 16), " z: " + LTRIM$(RTRIM$(STR$(INT(-nhat(3) * 100))))
        COLOR LimeGreen
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (5) * 16), " Swivel "
        COLOR DarkKhaki
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (4) * 16), " 7 8 9  "
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (3) * 16), " 4 5 6  "
        _PRINTSTRING (_WIDTH - (9) * 8, _HEIGHT - (2) * 16), " 1 2 3  "
        a = " - Closest - "
        COLOR LimeGreen
        _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (3) * 16), a
        a = " SPACE = Hide "
        COLOR LimeGreen
        _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (1) * 16), a
    END IF
    a = " " + Group(ClosestGroup).GroupName + " "
    COLOR DarkKhaki
    _PRINTSTRING (_WIDTH / 2 - (LEN(a) / 2) * 8, _HEIGHT - (2) * 16), a
END SUB
 
' Interface
 
SUB KeyProcess
    DIM modifier AS DOUBLE
    modifier = 0.05
 
    'IF (_KEYDOWN(100303) <> 0) OR (_KEYDOWN(100304) <> 0) THEN
    '    modifier = modifier * 10
    'END IF
    IF (_KEYDOWN(87) <> 0) OR (_KEYDOWN(119) <> 0) OR (_KEYDOWN(18432) <> 0) THEN ' W or w or uparrow
        CALL StrafeCameraNhatMinus
        IF (ToggleAnimate = 1) THEN
            PlayerCamera.Velocity.x = PlayerCamera.Velocity.x - modifier * nhat(1)
            PlayerCamera.Velocity.y = PlayerCamera.Velocity.y - modifier * nhat(2)
            PlayerCamera.Velocity.z = PlayerCamera.Velocity.z - modifier * nhat(3)
        END IF
    END IF
    IF (_KEYDOWN(83) <> 0) OR (_KEYDOWN(115) <> 0) OR (_KEYDOWN(20480) <> 0) THEN ' S or s or downarrow
        CALL StrafeCameraNhatPlus
        IF (ToggleAnimate = 1) THEN
            PlayerCamera.Velocity.x = PlayerCamera.Velocity.x + modifier * nhat(1)
            PlayerCamera.Velocity.y = PlayerCamera.Velocity.y + modifier * nhat(2)
            PlayerCamera.Velocity.z = PlayerCamera.Velocity.z + modifier * nhat(3)
        END IF
    END IF
    IF (_KEYDOWN(65) <> 0) OR (_KEYDOWN(97) <> 0) THEN ' A or a
        CALL StrafeCameraUhatMinus
        IF (ToggleAnimate = 1) THEN
            PlayerCamera.Velocity.x = PlayerCamera.Velocity.x - modifier * uhat(1)
            PlayerCamera.Velocity.y = PlayerCamera.Velocity.y - modifier * uhat(2)
            PlayerCamera.Velocity.z = PlayerCamera.Velocity.z - modifier * uhat(3)
        END IF
    END IF
    IF (_KEYDOWN(68) <> 0) OR (_KEYDOWN(100) <> 0) THEN ' D or d
        CALL StrafeCameraUhatPlus
        IF (ToggleAnimate = 1) THEN
            PlayerCamera.Velocity.x = PlayerCamera.Velocity.x + modifier * uhat(1)
            PlayerCamera.Velocity.y = PlayerCamera.Velocity.y + modifier * uhat(2)
            PlayerCamera.Velocity.z = PlayerCamera.Velocity.z + modifier * uhat(3)
        END IF
    END IF
    IF (_KEYDOWN(81) <> 0) OR (_KEYDOWN(113) <> 0) THEN ' Q or q
        CALL StrafeCameraVhatMinus
        IF (ToggleAnimate = 1) THEN
            PlayerCamera.Velocity.x = PlayerCamera.Velocity.x - modifier * vhat(1)
            PlayerCamera.Velocity.y = PlayerCamera.Velocity.y - modifier * vhat(2)
            PlayerCamera.Velocity.z = PlayerCamera.Velocity.z - modifier * vhat(3)
        END IF
    END IF
    IF (_KEYDOWN(69) <> 0) OR (_KEYDOWN(101) <> 0) THEN ' E or e
        CALL StrafeCameraVhatPlus
        IF (ToggleAnimate = 1) THEN
            PlayerCamera.Velocity.x = PlayerCamera.Velocity.x + modifier * vhat(1)
            PlayerCamera.Velocity.y = PlayerCamera.Velocity.y + modifier * vhat(2)
            PlayerCamera.Velocity.z = PlayerCamera.Velocity.z + modifier * vhat(3)
        END IF
    END IF
    IF (_KEYDOWN(19200) <> 0) OR (_KEYDOWN(52) <> 0) THEN CALL RotateUhatMinus: CALL CalculateScreenVectors ' 4
    IF (_KEYDOWN(19712) <> 0) OR (_KEYDOWN(54) <> 0) THEN CALL RotateUhatPlus: CALL CalculateScreenVectors ' 6
    IF (_KEYDOWN(56) <> 0) THEN CALL RotateVhatPlus: CALL CalculateScreenVectors ' 8
    IF (_KEYDOWN(50) <> 0) THEN CALL RotateVhatMinus: CALL CalculateScreenVectors ' 2
    IF (_KEYDOWN(55) <> 0) THEN CALL RotateClockwise ' 7
    IF (_KEYDOWN(57) <> 0) THEN CALL RotateCounterclockwise ' 9
    IF (_KEYDOWN(49) <> 0) THEN CALL RotateUhatMinus: CALL CalculateScreenVectors: CALL RotateClockwise ' 1
    IF (_KEYDOWN(51) <> 0) THEN CALL RotateUhatPlus: CALL CalculateScreenVectors: CALL RotateCounterclockwise ' 3
 
    DIM k AS LONG
    DIM p AS LONG
    DIM l AS LONG
    DIM kh AS INTEGER
    kh = _KEYHIT
    IF (kh <> 0) THEN
        SELECT CASE kh
            CASE 27
                SYSTEM
            CASE ASC(" ")
                ToggleHUD = -ToggleHUD
            CASE ASC("b"), ASC("B")
                DIM gtmp AS LONG
                gtmp = NewCube&(1, "Custom block", 350, PlayerCamera.Position.x - 40 * nhat(1), PlayerCamera.Position.y - 40 * nhat(2), PlayerCamera.Position.z - 40 * nhat(3), 10, 10, 10, Lime, Purple, Teal, 0)
                CALL ClusterPinch(gtmp)
            CASE ASC("k"), ASC("K")
                ' set -999? delete actual vectors? deal with cluster headers
                p = Group(ClosestGroup).Pointer
                l = Group(ClosestGroup).Lagger
                Group(l).Pointer = p
                IF (p <> -999) THEN
                    Group(p).Lagger = l
                END IF
            CASE ASC("m"), ASC("M")
                CALL CreateMission(10)
            CASE ASC("n"), ASC("N")
                FOR k = Group(ClosestGroup).FirstVector TO Group(ClosestGroup).LastVector
                    vec3Dvel(k, 1) = (RND - .5) * .20
                    vec3Dvel(k, 2) = (RND - .5) * .20
                    vec3Dvel(k, 3) = (RND - .5) * .20
                NEXT
            CASE ASC("o"), ASC("O")
                PlayerCamera.Position.x = -40
                PlayerCamera.Position.y = 30
                PlayerCamera.Position.z = 40
                uhat(1) = -.2078192: uhat(2) = -.9781672: uhat(3) = 0
                vhat(1) = 0: vhat(2) = 0: vhat(3) = 1
                CALL CalculateScreenVectors
            CASE ASC("t"), ASC("T")
                ToggleAnimate = -ToggleAnimate
        END SELECT
    END IF
    _KEYCLEAR
END SUB
 
' Color utility.
 
FUNCTION ShadeMix~& (Shade1 AS _UNSIGNED LONG, Shade2 AS _UNSIGNED LONG, Weight AS DOUBLE)
    ShadeMix~& = _RGB32((1 - Weight) * _RED32(Shade1) + Weight * _RED32(Shade2), (1 - Weight) * _GREEN32(Shade1) + Weight * _GREEN32(Shade2), (1 - Weight) * _BLUE32(Shade1) + Weight * _BLUE32(Shade2))
END FUNCTION
 
' Cartesian plotting.
 
SUB cline (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
    LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col
END SUB
 
SUB cpset (x1, y1, col AS _UNSIGNED LONG)
    PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
END SUB
 
SUB ccircle (x1 AS DOUBLE, y1 AS DOUBLE, rad AS DOUBLE, col AS _UNSIGNED LONG)
    CIRCLE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), rad, col
END SUB
 
SUB lineSmooth (x0, y0, x1, y1, c AS _UNSIGNED LONG)
    'Inspiration credit: {(FellippeHeitor)(qb64.org)(2020)}
    '                    {https://en.wikipedia.org/w/index.php?title=Xiaolin_Wu%27s_line_algorithm&oldid=852445548}
    'Edit: {(STxAxTIC)(2020-11-20)(Correction to alpha channel.)}
 
    DIM plX AS INTEGER, plY AS INTEGER, plI
 
    DIM steep AS _BYTE
    steep = ABS(y1 - y0) > ABS(x1 - x0)
 
    IF steep THEN
        SWAP x0, y0
        SWAP x1, y1
    END IF
 
    IF x0 > x1 THEN
        SWAP x0, x1
        SWAP y0, y1
    END IF
 
    DIM dx, dy, gradient
    dx = x1 - x0
    dy = y1 - y0
    gradient = dy / dx
 
    IF dx = 0 THEN
        gradient = 1
    END IF
 
    'handle first endpoint
    DIM xend, yend, xgap, xpxl1, ypxl1
    xend = _ROUND(x0)
    yend = y0 + gradient * (xend - x0)
    xgap = (1 - ((x0 + .5) - INT(x0 + .5)))
    xpxl1 = xend 'this will be used in the main loop
    ypxl1 = INT(yend)
    IF steep THEN
        plX = ypxl1
        plY = xpxl1
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = ypxl1 + 1
        plY = xpxl1
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    ELSE
        plX = xpxl1
        plY = ypxl1
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = xpxl1
        plY = ypxl1 + 1
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    END IF
 
    DIM intery
    intery = yend + gradient 'first y-intersection for the main loop
 
    'handle second endpoint
    DIM xpxl2, ypxl2
    xend = _ROUND(x1)
    yend = y1 + gradient * (xend - x1)
    xgap = ((x1 + .5) - INT(x1 + .5))
    xpxl2 = xend 'this will be used in the main loop
    ypxl2 = INT(yend)
    IF steep THEN
        plX = ypxl2
        plY = xpxl2
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = ypxl2 + 1
        plY = xpxl2
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    ELSE
        plX = xpxl2
        plY = ypxl2
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = xpxl2
        plY = ypxl2 + 1
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    END IF
 
    'main loop
    DIM x
    IF steep THEN
        FOR x = xpxl1 + 1 TO xpxl2 - 1
            plX = INT(intery)
            plY = x
            plI = (1 - (intery - INT(intery)))
            GOSUB plot
 
            plX = INT(intery) + 1
            plY = x
            plI = (intery - INT(intery))
            GOSUB plot
 
            intery = intery + gradient
        NEXT
    ELSE
        FOR x = xpxl1 + 1 TO xpxl2 - 1
            plX = x
            plY = INT(intery)
            plI = (1 - (intery - INT(intery)))
            GOSUB plot
 
            plX = x
            plY = INT(intery) + 1
            plI = (intery - INT(intery))
            GOSUB plot
 
            intery = intery + gradient
        NEXT
    END IF
 
    EXIT SUB
 
    plot:
    ' Change to regular PSET for standard coordinate orientation.
    CALL cpset(plX, plY, _RGB32(_RED32(c), _GREEN32(c), _BLUE32(c), plI * _ALPHA32(c)))
    RETURN
END SUB
 
' Camera transformation
 
SUB PlayerDynamics
    DIM k AS INTEGER
 
    IF (ToggleAnimate = 1) THEN
        PlayerCamera.Velocity.x = .95 * PlayerCamera.Velocity.x
        PlayerCamera.Velocity.y = .95 * PlayerCamera.Velocity.y
        PlayerCamera.Velocity.z = .95 * PlayerCamera.Velocity.z
        PlayerCamera.Position.x = PlayerCamera.Position.x + PlayerCamera.Velocity.x
        PlayerCamera.Position.y = PlayerCamera.Position.y + PlayerCamera.Velocity.y
        PlayerCamera.Position.z = PlayerCamera.Position.z + PlayerCamera.Velocity.z
    END IF
 
    FOR k = 1 TO MissionTicker
        IF (Group(ClosestGroup).GroupName = Mission(k).Label) THEN
            IF (Mission(k).Discovered = 0) THEN
                Mission(k).Discovered = 1
                SOUND 500, .25
            END IF
        END IF
    NEXT
END SUB
 
SUB RotateUhatPlus
    uhat(1) = uhat(1) + nhat(1) * .0333
    uhat(2) = uhat(2) + nhat(2) * .0333
    uhat(3) = uhat(3) + nhat(3) * .0333
END SUB
 
SUB RotateUhatMinus
    uhat(1) = uhat(1) - nhat(1) * .0333
    uhat(2) = uhat(2) - nhat(2) * .0333
    uhat(3) = uhat(3) - nhat(3) * .0333
END SUB
 
SUB RotateVhatPlus
    vhat(1) = vhat(1) + nhat(1) * .0333
    vhat(2) = vhat(2) + nhat(2) * .0333
    vhat(3) = vhat(3) + nhat(3) * .0333
END SUB
 
SUB RotateVhatMinus
    vhat(1) = vhat(1) - nhat(1) * .0333
    vhat(2) = vhat(2) - nhat(2) * .0333
    vhat(3) = vhat(3) - nhat(3) * .0333
END SUB
 
SUB RotateCounterclockwise
    DIM v1 AS DOUBLE
    DIM v2 AS DOUBLE
    DIM v3 AS DOUBLE
    v1 = vhat(1)
    v2 = vhat(2)
    v3 = vhat(3)
    vhat(1) = v1 + uhat(1) * .0333
    vhat(2) = v2 + uhat(2) * .0333
    vhat(3) = v3 + uhat(3) * .0333
    uhat(1) = uhat(1) - v1 * .0333
    uhat(2) = uhat(2) - v2 * .0333
    uhat(3) = uhat(3) - v3 * .0333
END SUB
 
SUB RotateClockwise
    DIM v1 AS DOUBLE
    DIM v2 AS DOUBLE
    DIM v3 AS DOUBLE
    v1 = vhat(1)
    v2 = vhat(2)
    v3 = vhat(3)
    vhat(1) = v1 - uhat(1) * .0333
    vhat(2) = v2 - uhat(2) * .0333
    vhat(3) = v3 - uhat(3) * .0333
    uhat(1) = uhat(1) + v1 * .0333
    uhat(2) = uhat(2) + v2 * .0333
    uhat(3) = uhat(3) + v3 * .0333
END SUB
 
SUB StrafeCameraUhatPlus
    PlayerCamera.Position.x = PlayerCamera.Position.x + uhat(1)
    PlayerCamera.Position.y = PlayerCamera.Position.y + uhat(2)
    PlayerCamera.Position.z = PlayerCamera.Position.z + uhat(3)
END SUB
 
SUB StrafeCameraUhatMinus
    PlayerCamera.Position.x = PlayerCamera.Position.x - uhat(1)
    PlayerCamera.Position.y = PlayerCamera.Position.y - uhat(2)
    PlayerCamera.Position.z = PlayerCamera.Position.z - uhat(3)
END SUB
 
SUB StrafeCameraVhatPlus
    PlayerCamera.Position.x = PlayerCamera.Position.x + vhat(1)
    PlayerCamera.Position.y = PlayerCamera.Position.y + vhat(2)
    PlayerCamera.Position.z = PlayerCamera.Position.z + vhat(3)
END SUB
 
SUB StrafeCameraVhatMinus
    PlayerCamera.Position.x = PlayerCamera.Position.x - vhat(1)
    PlayerCamera.Position.y = PlayerCamera.Position.y - vhat(2)
    PlayerCamera.Position.z = PlayerCamera.Position.z - vhat(3)
END SUB
 
SUB StrafeCameraNhatPlus
    PlayerCamera.Position.x = PlayerCamera.Position.x + nhat(1)
    PlayerCamera.Position.y = PlayerCamera.Position.y + nhat(2)
    PlayerCamera.Position.z = PlayerCamera.Position.z + nhat(3)
END SUB
 
SUB StrafeCameraNhatMinus
    PlayerCamera.Position.x = PlayerCamera.Position.x - nhat(1)
    PlayerCamera.Position.y = PlayerCamera.Position.y - nhat(2)
    PlayerCamera.Position.z = PlayerCamera.Position.z - nhat(3)
END SUB
 
'''
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 18, 2020, 12:04:06 pm

Hi @STxAxTIC

I tried your latest and not getting it, maybe need more instruction. By walking forward I assume arrow up key, I do encounter snow that I see and Winter Wonder Land (something like that) in descriptor but see no snowmen or trees I keep going and I seem to end up in space? Some turning left and right required? I did a little of that too, maybe more?

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 18, 2020, 12:29:02 pm

Well I am looking forward to Fellippe's, 2018 Christmas entry was a beauty!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: STxAxTIC on December 18, 2020, 12:39:58 pm

bplus do you spend any time in 3D simulations of any kind? i can make a video i suppose...

EDIT: I just found a snowman off the terrain, so I definitely have a placement variable wrong. Consider the above a prototype, haha.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 19, 2020, 03:50:37 pm

Well while waiting for STx to fix his, Fellippe, _vince, Ashish? TempodiBasic? I made another one that was going to go into my Christmas Album:

Programmable Tree Lights version 1 (proof of concept):

Code: QB64: [Select]

_TITLE "Programmable Tree Lights, press (&hold) 1, 2, 3 for program" ' b+ 2020-12-19
RANDOMIZE TIMER
CONST Xmax = 700, Ymax = 700, NLites = 55, RLite = 30
TYPE LiteSystem
    X AS SINGLE
    Y AS SINGLE
    C AS _UNSIGNED LONG
END TYPE
DIM SHARED L(1 TO NLites) AS LiteSystem
SCREEN _NEWIMAGE(Xmax, Ymax, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
 
' Get locations for a pyramid of circles st: ========================================================
'let n = number of circles at base of pile
n = 10
 
'let r = radius of each circle
r = RLite
 
'let base be total length of pile
baseLength = 2 * r * n
 
'center pyramid in middle of screen
startx = (Xmax - baseLength) / 2
 
 
'Stringing the lights on tree, adjusted to fit mostly on the tree
'stacking circles that form equilateral triangles at their origins have a height change of
deltaHeight = r * 3 ^ .5 'r times the sqr(3)
i = 1
FOR row = n TO 1 STEP -1
    IF row = n THEN y = Ymax - r - 1 ELSE y = y - deltaHeight
    FOR col = 1 TO row
        x = startx + col * 2 * r - r
        IF RND < .5 THEN
            r1 = (RND < .45): r2 = (RND < .33): r3 = (RND < .33)
            IF r1 = 0 AND r2 = 0 AND r3 = 0 THEN
                c~& = _RGB32(100 + RND * 155, 0, RND * 255)
            ELSE
                c~& = _RGB32(r1 * -(100 + RND * 155), r2 * -(100 + RND * 155), r3 * -(100 + RND * 155))
            END IF
        ELSE
            c~& = _RGB32(100 + RND * 155, 100 + RND * 155, 100 + RND * 155)
        END IF
        L(i).X = x: L(i).Y = y - 3.2 * r - 50: L(i).C = c~&
        i = i + 1
    NEXT
    startx = startx + r
NEXT
 
' making the stars
horizon = Ymax - 4 * r
nstars = 100
DIM xstar(100), ystar(100), rstar(100)
FOR i = 1 TO 100
    xstar(i) = RND * (Xmax): ystar(i) = RND * horizon:
    IF i < 75 THEN
        rstar(i) = 0
    ELSEIF i < 95 THEN
        rstar(i) = 1
    ELSE
        rstar(i) = 2
    END IF
NEXT
 
' making the background
back = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
CLS
FOR i = 0 TO horizon
    LINE (0, i)-(Xmax, i), _RGB32(i / horizon * 70, i / horizon * 22, 60 * (i) / horizon)
NEXT
land = Ymax - horizon
FOR i = horizon TO Ymax
    cc = 128 + (i - horizon) / land * 127
    LINE (0, i)-(Xmax, i), _RGB32(cc, cc, cc)
NEXT
FOR i = 1 TO 100
    fcirc xstar(i), ystar(i), rstar(i), &HFFEEEEFF
NEXT
_PUTIMAGE , 0, back
 
program$ = "1" ' just random
show program$ ' avoid the pause for key checking
DO
    t! = TIMER(.01) '                 needed this for better response to keypresses at such low _LIMIT on loop
    WHILE TIMER(.01) - t! < .25
        k$ = INKEY$
        IF LEN(k$) THEN
            IF INSTR("123", k$) > 0 THEN program$ = k$
            EXIT WHILE
        END IF
        _LIMIT 400
    WEND '                           dang!   still have to hold key down for a while
    _PUTIMAGE , back, 0
    show program$
    _DISPLAY
    _LIMIT 5
LOOP UNTIL INKEY$ = CHR$(27)
 
SUB show (prog$)
    STATIC offset
    Pinetree 25, 30, 650, 600
    SELECT CASE prog$
        CASE "1" 'random blink mostly on
            FOR i = 1 TO NLites
                IF RND < .8 THEN Lite L(i).X, L(i).Y, L(i).C
            NEXT
        CASE "2" ' random red white and blue
            FOR i = 1 TO NLites
                r = RND
                IF r < .33 THEN
                    Lite L(i).X, L(i).Y, &HFFCC0000
                ELSEIF r < .66 THEN
                    Lite L(i).X, L(i).Y, &HFFFFFFFF
                ELSE
                    Lite L(i).X, L(i).Y, &HFF0000BB
                END IF
            NEXT
        CASE "3" ' twinkle
            FOR i = 1 TO NLites
                fcirc L(i).X, L(i).Y, 2, &HFF00DDFF
                IF RND < .05 THEN Lite L(i).X, L(i).Y, &HFF00DDFF
            NEXT
    END SELECT
    _TITLE "Program: " + prog$ + "  Programmable Tree Lights, press (&hold) 1, 2, 3 for program"
END SUB
 
SUB Lite (x, y, c AS _UNSIGNED LONG)
    FOR r = 25 TO 0 STEP -1
        fcirc x, y, r, &H01FFFFFF
    NEXT
    fcirc x, y, 4, c
END SUB
 
SUB Pinetree (treeX, treeY, wide, high)
    'tannen baum by PeterMaria W  orig 440x460
    'fits here  LINE (0, 0)-(440, 410), , B
    STATIC t&
    IF t& = 0 THEN
        t& = _NEWIMAGE(440, 410, 32)
        _DEST t&
        bpx = 220: bpy = 410
        tpx = bpx
        FOR aa = -4 TO 4
            bpxx = bpx + aa
            bpyy = bpy - 390
            LINE (X + bpxx, y + bpy)-(X + bpx, y + bpyy), _RGB32(30, 30, 0)
        NEXT
        ra = 160
        tpy = bpy - 40
        FOR ht = 1 TO 40
            FOR xs = -100 TO 100 STEP 40
                xsh = xs / 100
                rs = RND * 4 / 10
                tpxx = tpx + (xsh * ra)
                tpyy = tpy - rs * ra
                LINE (X + tpx, y + tpy)-(X + tpxx, y + tpyy), _RGB32(50, 40, 20)
                FOR aa = 1 TO 30
                    fra = RND * 10 / 10 * ra
                    x1 = tpx + (xsh * fra)
                    y1 = tpy - rs * fra
                    x2 = tpx + xsh * (fra + ra / 5)
                    y2 = tpy - rs * fra + (-rs + (RND * 8) / 10 - 0.4) * (ra / 5)
                    LINE (X + x1, y + y1)-(X + x2, y + y2), _RGB32(RND * 80, RND * 70 + 40, RND * 60)
                NEXT
            NEXT
            ra = ra - 4
            tpy = tpy - 9
        NEXT
        _DEST 0
    END IF
    wf = wide / 440: hf = high / 410
    _PUTIMAGE (treeX, treeY)-STEP(440 * wf, 410 * hf), t&, 0
END SUB
 
'from Steve Gold standard
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
 
 

Feel free to take this and run with it, a 1000 ways to go from here! :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 19, 2020, 06:29:18 pm

You all are making such great stuff!! Very impressive. Works of art, really.

I tried making a good looking Christmas tree in code, but just couldn't. So I thought I'd share our Christmas tree here at home which I think is special. Every ornament was handmade by my mom, who is no longer with us. Guess I'm breaking the no external files suggestion, but @FellippeHeitor you did hint at a musical serenade during the zoom meeting, so the attachment is filling that suggestion.

Here's a peek into Christmas around here. A screensaver of our Christmas tree with some 'Silent Night' background music I quickly recorded today. You will need the attachment davstree.dat.

- Dav

Code: QB64: [Select]

'DavsTree.bas
'============
'Screensaver of my Christmas tree 2020
'Coded by Dav, DEC/2020, dedicated to my mother.
'MERRY CHRISTMAS EVERYONE!
 
'I just wanted to share what Christmas look around here.
'Here's our tree.  Every ornament was handmade by my mother.
'I'm improving on 'Silent Night'for the background music.
'Just having some fun playing, mistakes and all!   - Dav
 
SCREEN _NEWIMAGE(800, 600, 32)
 
'Start music
b& = _SNDOPEN("davstree.dat"): _SNDPLAY b&
 
_DELAY 1
FOR f = 1 TO 13
    ShowFrame "davstree.dat", f
NEXT
_DELAY 2
 
'stop music if playing
_SNDSTOP b&: _SNDCLOSE b&
 
 
:::::::::::::
::::: END:::: 'Merry Christmas!
:::::::::::::
 
'=============================================================
'Adapted from my QBV video format...
SUB ShowFrame (file$, framenum)
    FF = FREEFILE
    OPEN file$ FOR BINARY AS FF
    SEEK FF, LOF(FF) - 19
    Ver$ = INPUT$(7, FF) 'Version of QBV video format
    Audio$ = INPUT$(1, FF) 'Audio setting
    vidwidth = CVI(INPUT$(2, FF)) 'Width of video
    vidheight = CVI(INPUT$(2, FF)) 'Height of video
    VidData = CVL(INPUT$(4, FF)) 'Place in file Video data starts
    frames = CVI(INPUT$(2, FF)) 'How many frames in file
    fps = CVI(INPUT$(2, FF)) 'How many fps
    SEEK FF, VidData + 1
    FOR vid = 1 TO frames
        framelen$ = INPUT$(4, FF)
        frame$ = INPUT$(CVL(framelen$), FF)
        IF vid = framenum THEN EXIT FOR
    NEXT
    'make a temp jpg on disk
    FFF = FREEFILE
    OPEN "_tmp_qbv_frame_.jpg" FOR OUTPUT AS FFF
    PRINT #FFF, frame$;
    CLOSE FFF
    'load it
    frm& = _LOADIMAGE("_tmp_qbv_frame_.jpg")
    'erase it
    KILL "_tmp_qbv_frame_.jpg"
 
 
    'fade in from black...
    FOR a = 255 TO 0 STEP -4
        _PUTIMAGE (0, 0), frm&
        LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, a), BF
        _LIMIT 30
        _DISPLAY
    NEXT
 
    _DELAY 3.9
 
    'fade out to black
    FOR a = 0 TO 255 STEP 4
        _PUTIMAGE (0, 0), frm&
        LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, a), BF
        _LIMIT 30
        _DISPLAY
    NEXT
 
    _FREEIMAGE frm&
    CLOSE FF
 
END SUB
 
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 19, 2020, 06:48:56 pm

That was really nice, handmade ornaments remind me of Christmas's past. I think my sister took off with the ones I grew up with when she moved to Denver. We had things made from clothespins ( 2 varieties), Popsicle sticks, pine cones, foil, pie tins, tiny photos... Specially valued were 3 old ornaments from Grandma's house one was a small sphere with clock face. She used to host Christmas with 2 sets of families for like 25 years.

Love the music with the story!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 19, 2020, 09:15:02 pm

Here is version #2 of Programmable Tree Lights, new pyramid scheme, 10 color sets, 4 direction modes:
Press digit for color set, letter keys for wave direction h = horizontal, v = vertical, d = diagonal, e = diagonal the other way :)

Code: QB64: [Select]

_TITLE "Programmable Tree Lights v2" ' b+ 2020-12-19
RANDOMIZE TIMER
CONST Xmax = 700, Ymax = 700, N_Rows = 10, N_Cols = 2 * N_Rows - 1
CONST X_Spacer = 30, Y_Spacer = 52, X_Offset = 50
TYPE ColorSeed
    Red AS SINGLE
    Green AS SINGLE
    Blue AS SINGLE
END TYPE
DIM SHARED ColorSet(10) AS ColorSeed, ColorSetIndex AS LONG
DIM SHARED pR, pG, pB, pN, pStart, pMode$
DIM SHARED TG(1 TO N_Cols, 1 TO N_Rows) AS LONG
SCREEN _NEWIMAGE(Xmax, Ymax, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
 
' setup some color seeds in ColorSet user can change out with Shift + digit key
FOR i = 0 TO 9 ' 10 random color seeds
    resetPlasma
    ColorSet(i).Red = pR: ColorSet(i).Green = pG: ColorSet(i).Blue = pB
NEXT
 
'Stringing the lights on tree, adjusted to fit mostly on the tree   2*N - 1 Pryramid
FOR row = 1 TO 10
    l$ = xStr$(2 * row - 1, "X")
    o$ = xStr$(10 - row, "O")
    b$ = o$ + l$ + o$
    FOR Col = 1 TO N_Cols
        IF MID$(b$, Col, 1) = "O" THEN TG(Col, row) = 0 ELSE TG(Col, row) = -1
    NEXT
    PRINT b$
NEXT
 
' making the stars
horizon = Ymax - 4 * r
nstars = 100
DIM xstar(100), ystar(100), rstar(100)
FOR i = 1 TO 100
    xstar(i) = RND * (Xmax): ystar(i) = RND * horizon:
    IF i < 75 THEN
        rstar(i) = 0
    ELSEIF i < 95 THEN
        rstar(i) = 1
    ELSE
        rstar(i) = 2
    END IF
NEXT
CLS
' make a circle tree and align circles to tree with spacers and offsets with new Pyramid Scheme
'Pinetree 25, 30, 650, 600
'FOR row = 1 TO N_Rows
'    FOR col = 1 TO N_Cols
'        IF TG(col, row) THEN CIRCLE (col * X_Spacer + X_Offset, row * Y_Spacer), 10
'    NEXT
'NEXT
 
' making the background
back = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
CLS
horizon = Ymax - 100
FOR i = 0 TO horizon
    LINE (0, i)-(Xmax, i), _RGB32(i / horizon * 70, i / horizon * 22, 60 * (i) / horizon)
NEXT
land = Ymax - horizon
FOR i = horizon TO Ymax
    cc = 128 + (i - horizon) / land * 127
    LINE (0, i)-(Xmax, i), _RGB32(cc, cc, cc)
NEXT
FOR i = 1 TO 100
    fcirc xstar(i), ystar(i), rstar(i), &HFFEEEEFF
NEXT
_PUTIMAGE , 0, back
 
ColorSetIndex = 1: pMode$ = "h"
show ' avoid the pause for key checking
DO
    k$ = INKEY$
    IF LEN(k$) THEN
        IF INSTR("0123456789", k$) > 0 THEN
            ColorSetIndex = VAL(k$)
        ELSEIF INSTR("vhde", k$) > 0 THEN
            pMode$ = k$
        END IF
    END IF
    _PUTIMAGE , back, 0
    show
    _DISPLAY
    _LIMIT 10
LOOP UNTIL INKEY$ = CHR$(27)
 
SUB show
    Pinetree 25, 30, 650, 600
    _TITLE "Programmable Tree Lights (0-9) Color Set: " + TS$(ColorSetIndex) + "  (v, h, d, e) Mode: " + pMode$
    pR = ColorSet(ColorSetIndex).Red: pG = ColorSet(ColorSetIndex).Green: pB = ColorSet(ColorSetIndex).Blue
    pStart = pStart + 1
    SELECT CASE pMode$
        CASE "h"
            FOR row = 1 TO N_Rows
                pRow = pStart + row
                FOR col = 1 TO N_Cols
                    pN = pRow
                    IF TG(col, row) THEN Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
                NEXT
            NEXT
        CASE "v"
            FOR row = 1 TO N_Rows
                FOR col = 1 TO N_Cols
                    pN = pStart + col
                    IF TG(col, row) THEN Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
                NEXT
            NEXT
        CASE "d"
            FOR row = 1 TO N_Rows
                FOR col = 1 TO N_Cols
                    pN = pStart + col - row
                    IF TG(col, row) THEN Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
                NEXT
            NEXT
        CASE "e"
            FOR row = 1 TO N_Rows
                FOR col = 1 TO N_Cols
                    pN = pStart + row + col
                    IF TG(col, row) THEN Lite col * X_Spacer + X_Offset, row * Y_Spacer, Plasma~&
                NEXT
            NEXT
 
    END SELECT
END SUB
 
SUB Lite (x, y, c AS _UNSIGNED LONG)
    cAnalysis c, cR, cG, cB, cA
    FOR r = 35 TO 0 STEP -2
        fcirc x, y, r, _RGB32(cR, cG, cB, 1)
    NEXT
    fcirc x, y, 4, c
END SUB
 
SUB Pinetree (treeX, treeY, wide, high)
    'tannen baum by PeterMaria W  orig 440x460
    'fits here  LINE (0, 0)-(440, 410), , B
    STATIC t&
    IF t& = 0 THEN
        t& = _NEWIMAGE(440, 410, 32)
        _DEST t&
        bpx = 220: bpy = 410
        tpx = bpx
        FOR aa = -4 TO 4
            bpxx = bpx + aa
            bpyy = bpy - 390
            LINE (X + bpxx, y + bpy)-(X + bpx, y + bpyy), _RGB32(30, 30, 0)
        NEXT
        ra = 160
        tpy = bpy - 40
        FOR ht = 1 TO 40
            FOR xs = -100 TO 100 STEP 40
                xsh = xs / 100
                rs = RND * 4 / 10
                tpxx = tpx + (xsh * ra)
                tpyy = tpy - rs * ra
                LINE (X + tpx, y + tpy)-(X + tpxx, y + tpyy), _RGB32(50, 40, 20)
                FOR aa = 1 TO 30
                    fra = RND * 10 / 10 * ra
                    x1 = tpx + (xsh * fra)
                    y1 = tpy - rs * fra
                    x2 = tpx + xsh * (fra + ra / 5)
                    y2 = tpy - rs * fra + (-rs + (RND * 8) / 10 - 0.4) * (ra / 5)
                    LINE (X + x1, y + y1)-(X + x2, y + y2), _RGB32(RND * 80, RND * 70 + 40, RND * 60)
                NEXT
            NEXT
            ra = ra - 4
            tpy = tpy - 9
        NEXT
        _DEST 0
    END IF
    wf = wide / 440: hf = high / 410
    _PUTIMAGE (treeX, treeY)-STEP(440 * wf, 410 * hf), t&, 0
END SUB
 
SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
    outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
END SUB
 
FUNCTION Plasma~& ()
    pN = pN + 1 'dim shared cN as _Integer64, pR as integer, pG as integer, pB as integer
    Plasma~& = _RGB32(127 + 127 * SIN(pR * pN), 127 + 127 * SIN(pG * pN), 127 + 127 * SIN(pB * pN))
END FUNCTION
 
SUB resetPlasma ()
    pR = RND ^ 2: pG = RND ^ 2: pB = RND ^ 2: pN = 0
END SUB
 
FUNCTION xStr$ (x, strng$)
    FOR i = 1 TO x
        xStr$ = xStr$ + strng$
    NEXT
END FUNCTION
 
FUNCTION TS$ (n AS INTEGER)
    TS$ = _TRIM$(STR$(n))
END FUNCTION
 
'from Steve Gold standard
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
 
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 20, 2020, 09:41:54 am

Thanks, @bplus. My wife begs me to throw those old ornaments out every year, but it ain't gonna happen. Haven't ran your last post yet, but the code looks interesting...

- Dav

Title: Re: %uD83C%uDF84%uD83C%uDF81%u2728 Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 20, 2020, 11:24:45 am

@Dav
That.
Was.
So.
Wholesome.

Man, you rocked that Silent Night! That was amazing! Being able to peek through your X-Mas tree and seeing the hand-made ornaments was so heartwarming.

I thank you so much for sharing that piece. It's wonderful.

@everyone else, I'm still to check your pieces... I'll finally begin having some time off in this holiday season. I'll check your entries soon.

Just to make sure we're all on the same page: is it ok to feature you guys' contributions in a video compilation on our youtube channel?

@Dav is it ok to feature your Silent Night rendition on said video?

PS: I'm running it again and watching the temp files being generated one by one in real time in the background! That's so cool!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: jack on December 20, 2020, 08:53:40 pm

Dav that was awesome :)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 21, 2020, 08:02:34 am

Thanks guys!

@FellippeHeitor: sure, you can use my silent night version on your videos. I wish i had made another recording though, it was a quick 1st take on a cheap keyboard at the last minute, just to add some sound to make it more interesting. Anyway, glad you like it!

Im thinking to expand this idea into a slideshow kit, i have some screen fx and wipes to use.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 21, 2020, 08:13:50 am

@Dav: Now I've run your program and it's a really beautiful job. Merry Christmas! :)

@FellippeHeitor: I will be honored if you add a video from my program to a video on the Youtube site QB64.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 21, 2020, 09:38:15 am

Thankyou @Petr. By the way, have you posted the source code of the easy 3d tunnel video you have on your youtube channel? Looks cool!

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 21, 2020, 10:32:22 am

@Dav: This is just an appetizer :) The code will be available as soon as I add the turns.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Adrian on December 22, 2020, 04:46:51 am

very cool programs everyone!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: SMcNeill on December 22, 2020, 07:13:48 pm

And something which might make a nice little screensaver of sorts, for the season:

Code: QB64: [Select]

SCREEN _NEWIMAGE(1280, 720, 32)
RANDOMIZE TIMER
 
TYPE Firework
    x AS _FLOAT
    y AS _FLOAT
    Xchange AS _FLOAT
    Ychange AS _FLOAT
    color AS _UNSIGNED LONG
    countdown AS _FLOAT
END TYPE
 
TYPE Sparks
    x AS _FLOAT
    y AS _FLOAT
    Xchange AS _FLOAT
    Ychange AS _FLOAT
    color AS _UNSIGNED LONG
    countdown AS _FLOAT
END TYPE
 
 
 
 
DIM SHARED Firework(20) AS Firework
DIM SHARED Sparks(180 * 21) AS Sparks
FOR i = 0 TO UBOUND(firework): GenerateFirework (i): NEXT
f = _LOADFONT("OLDENGL.TTF", 72)
_FONT f
 
DO
    LINE (0, 0)-(1280, 720), _RGBA32(0, 0, 0, 10), BF
    DisplayMessage
    FOR i = 0 TO UBOUND(firework)
        Firework(i).x = Firework(i).x + Firework(i).Xchange
        Firework(i).y = Firework(i).y + Firework(i).Ychange
        CircleFill Firework(i).x, Firework(i).y, 5, Firework(i).color
        IF Firework(i).countdown < ExtendedTimer THEN
            GenerateSparks (i)
            GenerateFirework (i)
        END IF
    NEXT
    FOR i = 0 TO UBOUND(sparks)
        Sparks(i).x = Sparks(i).x + Sparks(i).Xchange
        Sparks(i).y = Sparks(i).y + Sparks(i).Ychange
        CircleFill Sparks(i).x, Sparks(i).y, 2, Sparks(i).color
        IF Sparks(i).countdown < ExtendedTimer THEN Sparks(i).color = 0
    NEXT
    _LIMIT 60
    _DISPLAY
LOOP UNTIL _KEYHIT
 
 
 
SUB GenerateFirework (which)
    Firework(which).x = RND * _WIDTH(0)
    Firework(which).y = 720
    DO: Firework(which).Xchange = RND * 8 - 4: LOOP UNTIL Firework(which).Xchange <> 0
    DO: Firework(which).Ychange = RND * -4: LOOP UNTIL Firework(which).Ychange <> 0
    Firework(which).color = _RGB32(RND * 256, RND * 256, RND * 256)
    Firework(which).countdown = ExtendedTimer + RND * 8
END SUB
 
SUB GenerateSparks (which)
    count = 180 * which - 1
    DIM cd AS _FLOAT: cd = ExtendedTimer + RND * 4
    FOR j = 0 TO _D2R(360) STEP _D2R(2)
        count = count + 1
        Sparks(count).x = Firework(which).x
        Sparks(count).y = Firework(which).y
        r = RND * 3
        Sparks(count).Xchange = SIN(j) * r
        Sparks(count).Ychange = COS(j) * r
        Sparks(count).color = Firework(which).color
        Sparks(count).countdown = ExtendedTimer + RND * 4
    NEXT
END SUB
 
 
SUB DisplayMessage
    STATIC T AS _FLOAT, c AS _FLOAT
    IF T = 0 THEN T = ExtendedTimer
    et = ExtendedTimer - T 'elapsed time
    SELECT CASE et
        CASE IS < 8
            c = 255 / 8 * (et - 0) 'fade in
            text$ = "Merry Christmas"
        CASE IS < 16
            c = 255 - 255 / 8 * (et - 8) 'fade out
            text$ = "Merry Christmas"
        CASE IS < 32
            c = 255 / 8 * (et - 16) 'fade in
            text$ = "Happy New Years"
        CASE IS < 48
            c = 255 - 255 / 8 * (et - 32) 'fade out
            text$ = "Happy New Years"
        CASE ELSE
            T = ExtendedTimer
    END SELECT
    COLOR _RGB32(c), 0
    _PRINTSTRING ((_WIDTH - _PRINTWIDTH(text$)) / 2, 320), text$
END SUB
 
 
 
SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  R = radius
    '  C = fill color
    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
 
FUNCTION ExtendedTimer##
    d$ = DATE$
    l = INSTR(d$, "-")
    l1 = INSTR(l + 1, d$, "-")
    m = VAL(LEFT$(d$, l))
    d = VAL(MID$(d$, l + 1))
    y = VAL(MID$(d$, l1 + 1)) - 1970
    FOR i = 1 TO m
        SELECT CASE i 'Add the number of days for each previous month passed
            CASE 1: d = d 'January doestn't have any carry over days.
            CASE 2, 4, 6, 8, 9, 11: d = d + 31
            CASE 3: d = d + 28
            CASE 5, 7, 10, 12: d = d + 30
        END SELECT
    NEXT
    FOR i = 1 TO y
        d = d + 365
    NEXT
    FOR i = 2 TO y STEP 4
        IF m > 2 THEN d = d + 1 'add an extra day for leap year every 4 years, starting in 1970
    NEXT
    d = d - 1 'for year 2000
    s~&& = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
    ExtendedTimer## = (s~&& + TIMER)
END FUNCTION
 

If needed, font can be downloaded here: https://www.wfonts.com/download/data/2015/11/25/oldenglish/OLDENGL.TTF

Title: Re: %uD83C%uDF84%uD83C%uDF81%u2728 Holiday Season - are you ready to code?
Post by: Dav on December 22, 2020, 09:59:32 pm

Quote from: FellippeHeitor on December 20, 2020, 11:24:45 am

@Dav is it ok to feature your Silent Night rendition on said video?

@FellippeHeitor would you need a higher quality sound file for that? I haven't deleted the original recording yet (was about too then I thought of this request). The one in the screen save was saved at the lowest quality to make the filesize attachment limit.

@Steve: Nice fireworks! I had to comment the olde english font first, my system doesn't have it.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 22, 2020, 10:01:14 pm

@Dav I was gonna extract it from your resource file, but a higher quality version sure comes handy.

Title: Re: %uD83C%uDF84%uD83C%uDF81%u2728 Holiday Season - are you ready to code?
Post by: SMcNeill on December 23, 2020, 01:15:20 am

Quote from: Dav on December 22, 2020, 09:59:32 pm

@Steve: Nice fireworks! I had to comment the olde english font first, my system doesn't have it.

- Dav

I thought it was a standard Windows font, but after doing some digging, it seems it's from MS Office (Word). There's a link to it above, now, if you want to see it with the proper font is use. ;)

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 23, 2020, 10:49:10 am

My lazy 2020 submission: Xmas Themed LED Gif Player (loud beeping song warning!):

Code: QB64: [Select]

OPTION _EXPLICIT
 
TYPE object
    x AS SINGLE
    y AS SINGLE
    c AS _UNSIGNED LONG
END TYPE
 
SCREEN _NEWIMAGE(800, 540, 32)
 
'78x52
CONST maxW = 78
CONST maxH = 52
DIM px(1 TO maxW, 1 TO maxH) AS object
DIM i AS INTEGER, j AS INTEGER, temp$
DIM frame AS INTEGER
 
CONST offset = 5
FOR i = 1 TO maxW
    FOR j = 1 TO maxH
        px(i, j).x = offset + i * 10
        px(i, j).y = offset + j * 10
    NEXT
NEXT
 
' We Wish You a Merry Christmas
' from http://www.devsuperpage.com/search/Articles.aspx?G=5&ArtID=116269
PLAY "mb t120"
PLAY "o3l4dgg8a8g8f#8"
PLAY "eceaa8b8a8g8f#dd"
PLAY "bb8o4c8o3b8a8ged8d8eaf#g2"
PLAY "dgggf#2f#gf#ed2a"
PLAY "ba8a8g8g8o4do3dd8d8eaf#g2"
PLAY "p1"
 
DO
    frame = frame + 1
    IF frame > 4 THEN frame = 1
 
    SELECT CASE frame
        CASE 1: RESTORE frame1
        CASE 2: RESTORE frame2
        CASE 3: RESTORE frame3
        CASE 4: RESTORE frame4
    END SELECT
 
    CLS
    FOR j = 1 TO maxH
        FOR i = 1 TO maxW
            READ temp$
            IF temp$ <> "0" THEN
                px(i, j).c = VAL("&H" + temp$)
            ELSE
                px(i, j).c = _RGB32(21)
            END IF
            CircleFill px(i, j).x, px(i, j).y, 2, px(i, j).c
        NEXT
    NEXT
 
    _DISPLAY
    _LIMIT 5
LOOP
 
'image source https://giphy.com/gifs/studiosoriginals-merry-christmas-3o6fJdYXEvMa5ZmlI4
 
frame1:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF130303,FF0C0A03,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1B0404,FF0B0202,0,FF0B0202,0,0,FF0B0202,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF130303,FF0B0202,0,FF0B0202,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1B0404,0,FF9A3434,FFC54C4C,0,FF130303,0,0,0,0,0,FF0B0202,0,0,FF130303,FF1B0404,FF1B0404,FF130303,FF0B0202,0,0,FF130303,0,0,FF0B0202,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF771B1B,FF3C0000,FF000C0B,0,FFEE6D6D,FFD76565,0,FF1D150D,FF130303,0,0,FF1D0A0A,FF1B0404,FF0B0B0B,0,FF130303,0,0,0,0,0,FF631313,FF4B1212,0,FFA73C3C,FFBB4545,0,FF1D0A0A,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0A1A0C,FF0C130C,0,0,0,FF0A1A0C,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0202,FF000C0B,FF2C0000,FFEB6262,FF9A3434,0,FF8D211F,FFFF7E7E,FFB44343,0,FF2A0F10,0,0,FF0B0202,0,0,0,FF1B0404,0,FF7B2323,FF8D211F,FF9A3434,FFAD4341,0,FFE45C5C,FF8C2D2D,0,FFF46C6C,FFBC4A4A,0,FF220B0B,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF0A040A,FF0A1A0C,FF0B0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0A1A0C,0,0,0,0,0,0,0,0,0,0,FF1B0404,0,FF5B0101,FFFF7E7E,FFBC4A4A,0,FFD45354,FFFD6B6B,FF9A3434,0,0,FF5B0101,FF220202,FF1B0404,FFB44343,FF9B2A29,FFD45354,FF6F1D1D,0,FFBC4A4A,FFF26665,FFFA7272,FFB54A48,FF4C0000,FFF46C6C,FF5B0101,FF8C2D2D,FFFA7272,FF540000,0,FF130303,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF021F00,FF3E7C3F,FF316B32,0,0,0,FF438645,FF143C15,0,FF0A1A0C,0,0,0,0,0,0,0,0,0,FF030B03,0,0,0,0,0,FF030B03,0,0,0,0,0,FF1B0404,0,FF832525,FFFA7272,FFCC5151,FF871314,FFE45C5C,FFE15555,FF8C2D2D,0,FFBB4545,FFF26665,FFC54C4C,FF630000,FFF46C6C,FFEB6262,FFEE6D6D,FF430101,0,FFDD5A5A,FFAF2D2D,FFDB5555,FF7B2323,FF832525,FFF46C6C,0,FFC54C4C,FFD45354,0,FF1D0A0A,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0B0B0B,0,FF78CC7A,FF71CC73,FF5CB35D,FF3E7C3F,FF4B994D,FF83DD84,FF2A642C,0,0,0,0,0,0,FF041304,0,0,FF0C130C,FF030B03,FF030B03,FF539452,FF143C15,0,FF131D0F,FF131414,0,0,0,0,0,FF220B0B,FF2A0F10,0,FFAD4341,FFE15555,FFD74C4C,FFD45354,FFC64242,FFDD5A5A,FF6E1414,FF9A3434,FFE45C5C,FFAD2626,FFE45C5C,FFAF2D2D,FFD45354,FFAD2626,FFD45354,0,FF7B2323,FFEB6262,FF6B0000,FFE45C5C,FF540000,FFB54A48,FFFF7E7E,FF870000,FFFA7272,FFA73C3C,0,FF1D0A0A,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF041304,0,FF2A642C,FF5CB35D,FF186C1C,FF63BC65,FF56A358,FF52AC54,FF357837,FF003000,FF61AC62,FF0E2F0F,0,FF030B03,0,0,0,FF0A1A0C,0,0,FF205422,FF88E38A,FF357837,0,0,0,FF003B00,FF0A1A0C,0,FF0B0202,0,0,0,0,FFD45354,FFB43535,FFDD5A5A,FFFA7272,FF870000,FFE56161,FF630000,FFDD5A5A,FFAF2D2D,FFE45C5C,FFB43535,FFDB5555,FFA33636,FFB33C3B,FFCC5151,0,FFDD5A5A,FFBB4545,0,FFE56161,FFBA3C3C,FFE45C5C,FFE45C5C,FFE45C5C,FFF46C6C,FFA73C3C,0,FF1D0A0A,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF131414,0,FF66C069,FF3E7C3F,FF003000,FF003000,FF438645,FF6CC66D,FF63BC65,FF7AD57C,FF114713,0,FF030B03,0,FF2A642C,0,FF021F00,FF71C373,FF014803,FF519C53,FF5EBA60,FF5AAC5C,FF316B32,FF4B994D,FF71C373,FF71C373,0,FF14140D,0,FF220202,FFB44343,FF832928,FF340101,FFEB6262,FF630000,FFAD4341,FFBC4A4A,FF5B0101,FFE45C5C,FF5B0101,FFDB5555,FFE15555,FFBA3C3C,FFAF2D2D,FFEB6262,0,FF9A3434,FFEA5E5E,FFCC4C4C,FFDD5A5A,FF220202,0,FF922E2E,FFE45C5C,FFB33C3B,FFA31D1D,FFC64242,FFC64242,FFBC4A4A,0,FF220B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0C130C,0,FF71C373,FF7AD57C,FF005700,FF316B32,FF62B464,FF003B00,FF5AAC5C,FF278532,FF52AC54,0,0,FF1C1D1D,0,FF71CC73,FF62B464,FF005700,FF71CC73,FF6CC66D,FF66C069,FF003000,FF66C069,FF5CB35D,FF52AC54,FF7AD57C,FF316B32,0,FF1C1B0C,0,FFCC4C4C,FFE45C5C,FF430101,FF9A3434,FFE45C5C,0,0,0,FF4A0D00,FFEB6262,FFAF2D2D,FFE15555,FFDB5555,FFB33C3B,FFF26665,FF832525,0,FF220202,FFB44343,FFC54C4C,FF430101,0,FF1B0404,0,0,FF630000,FFF26665,FF8D211F,FFC54C4C,FFBC4A4A,0,FF220B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF2A642C,FF429544,FF71CC73,FF3C893E,FF5CB35D,FF3B733A,0,FF5AAC5C,FF5EBA60,FF3C893E,FF3E7C3F,0,0,FF5CB35D,FF52AC54,FF73D375,FF4B994D,FF498A4A,FF3B733A,0,0,FF003000,FF6BBE6D,FF316B32,0,FF131D0F,0,FF4C0000,FFEB6262,FF4C0000,0,FFEA5E5E,FFA33636,0,FF24221A,FF130303,0,FFBB4545,FFE45C5C,FF8D211F,FFBC4A4A,FFCD3448,FF6B0000,0,FF1D0A0A,0,0,0,0,FF130303,0,FF2A0F10,0,FFC54C4C,FFC54C4C,0,FFDD5A5A,FFA73C3C,0,FF220B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF030B03,0,FF003000,FF459D48,FF63BC65,FF316B32,FF357837,FF63BC65,0,FF61AC62,FF5AAC5C,FF73D375,FF52A454,FF5AAC5C,FF52A454,FF5CB35D,FF003000,FF61AC62,FF3E7C3F,0,FF438645,FF63BC65,FF2B762D,FF6CC66D,FF368538,0,FF0E2F0F,0,FF0B0B0B,0,FFD45354,FFD45354,FFDB5555,FFD45354,0,0,0,FF316B32,FF174B1A,0,FF041304,0,0,FF038140,FF3A8C4C,FF021F00,FF0A1A0C,FF131D0F,FF1C0709,FF2A0F10,FF4C0000,FF0B0202,0,FF220B0B,0,FFC54C4C,FFD45354,FFA83232,FFEB6262,FF4C0000,0,FF130303,FF0B0202,0,0,FF130303,FF220B0B,FF0B0202,0,0,0
DATA 0,0,0,0,0,0,0,FF0A1A0C,0,FF56A358,FF83DD84,FF429544,0,0,FF62B464,FF438645,0,FF021F00,FF63BC65,FF003000,FF62B464,FF73D375,FF71CC73,0,0,FF357837,FF66C069,FF5CB35D,FF014803,FF519C53,FF71CC73,FF5EBA60,FF7AD57C,FF003000,0,FF1D0A0A,0,FF430101,FFB44343,FFA73C3C,FF0B0202,0,FF316B32,FF71C373,FF83DD84,FF80D381,0,0,FF3B733A,FF80D381,FF71CC73,FF88E38A,FF498A4A,0,0,FF030B03,FF631313,FFD45354,FF340101,0,FF130303,0,FF580C0C,FFD45354,FFDD5A5A,FF771B1B,0,FF2A0F10,FF130303,0,0,FF130303,0,0,0,FF0B0202,0,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,FF205422,FF52A454,FF71CC73,FF3B733A,FF114713,FF6CC66D,0,FF438645,FF5AAC5C,0,FF5CB35D,FF2B762D,FF205422,FF003B00,FF62B464,FF63BC65,FF2A642C,0,0,0,FF459D48,FF71CC73,FF498A4A,0,FF1D150D,0,0,FF000C0B,0,0,FF0A1A0C,0,FF519C53,FF429544,FF71C373,FF6AB36B,0,FF62B464,FF88E38A,FF498A4A,FF014803,FF80D381,FF005700,FF438645,FF539452,0,FF832928,FFD45354,0,FF0B0B0B,FF1B0404,FF1B0404,0,0,0,0,FF000C0B,0,0,FF2C0000,FF1B0404,0,FF631313,FFB44343,FF580C0C,0,FF0B0202,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF3C893E,FF6CC66D,FF357837,0,FF519C53,FF5AAC5C,FF005700,FF4B994D,FF2B762D,FF66C069,0,FF357837,FF6CC66D,FF498A4A,0,0,0,FF498A4A,FF63BC65,FF52A454,FF114713,0,FF1D150D,0,FF130303,FF4C0000,0,FF1D0A0A,FF1B0404,FF220202,FF62211A,0,FF2A642C,FF80D381,FF014803,FF78CC7A,FF78CC7A,FF003B00,0,FF205422,FF80D381,FF78CC7A,FF7AD57C,FF438645,FF540000,FFB33C3B,FFD24545,FFB33C3B,FF340101,0,0,0,0,FF000C0B,0,FF3C0000,FFBC4A4A,FFB33C3B,FFCC4C4C,0,FF631313,FFDB5555,FFFD6B6B,FF9A3434,0,FF220202,0
DATA 0,0,0,0,0,0,0,0,FF0A1A0C,0,FF539452,FF88E38A,FF52AC54,FF5AAC5C,FF174B1A,0,FF5AAC5C,FF52AC54,FF6CC66D,FF63BC65,FF5AAC5C,FF52AC54,FF6CC66D,FF174B1A,0,FF0E2F0F,FF021F00,0,FF52A454,FF73D375,FF56A358,FF205422,FF1B0404,0,FF832525,FFE45C5C,FFEA5E5E,FFBB4545,0,0,FF832525,FFCC5151,0,FF528E51,FF83DD84,FF7AD57C,FF6AB36B,0,0,FF24221A,0,FF2A642C,FF498A4A,0,0,FF8C2D2D,FFD74C4C,FFC64242,FFA33636,FF630000,FF7B2323,FF6E1414,FF8C2D2D,FFBC4A4A,FF580C0C,0,FFCC5151,FFDB5555,FFD24545,FFDD5A5A,0,FFBC4A4A,FFE45C5C,FF760000,FF551913,0,FF0B0202,0
DATA 0,0,0,0,0,0,0,0,0,0,FF0E2F0F,FF003000,FF52AC54,FF7AD57C,FF3C893E,FF498A4A,FF278532,FF66C069,FF6CC66D,0,FF63BC65,FF52A454,0,0,0,FF4B994D,FF78CC7A,FF5CB35D,FF5CB35D,FF63BC65,FF80D381,FF3E7C3F,0,FF60110A,FFEB6262,FFA33636,FF5B0101,FFEA5E5E,FF9A3434,0,FFBB4545,FFC54C4C,0,FF152600,FF6AB36B,FF539452,0,0,FF14140D,0,0,0,0,FF7B2323,FF62211A,0,FFCC4C4C,FFA33636,0,FFDB5555,FFD74C4C,FFEB6262,FFD24545,FFE45C5C,FFC54C4C,FF3C0000,FFEB6262,FF3C0000,FFB44343,FFCC4C4C,0,FF540000,FFDD5A5A,FFD45354,FF1B0404,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0A1A0C,0,FF3B733A,FF88E38A,FF5EBA60,FF5AAC5C,FF459D48,FF83AF61,FF6FAC58,FF006A08,FF62B464,FF459D48,FF368538,FF5AAC5C,FF5AAC5C,FF519C53,FF429544,FF6CC66D,FF3C893E,FF205422,FF114713,0,FF0B0202,0,FFCC4C4C,FFC54C4C,0,0,FFDB5555,FFB44343,0,FFDB5555,FF9A3434,0,FF2A0F10,0,0,FF551913,FF9A3434,0,FF62211A,FF8C2D2D,0,FFB54A48,FFFD6B6B,FFD3565D,0,FFE45C5C,FF8C2D2D,FF6E1414,FFEB6262,FF6B0000,FFE56161,FF6B0000,FFA73C3C,FFCC5151,FF6B0000,FFE45C5C,FF1B0404,FFD45354,FF9B2A29,FFA33636,FFB44343,0,FFE45C5C,FFA73C3C,0,FF220202,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,0,FF2F5724,FF3B733A,FF262B0C,0,FF86002F,FFD3565D,FFC54E54,FF5C934D,FF7AD57C,FF459D48,FF88E38A,FF63BC65,FF2B762D,FF4B994D,FF52A454,FF71CC73,FF6BBE6D,0,FF0B0202,FF1D1D12,FF000C0B,FF430101,FFEB6262,FF771B1B,0,FFB33C3B,FFE45C5C,FF430101,FF2C0000,FFE45C5C,FF9B2A29,FF580C0C,0,FFB54A48,FFC54C4C,FFE56161,FFE56161,0,FFBB4545,FFCC5151,FF4C0000,FFF46C6C,FFAF2D2D,FFBB4545,FF540000,FFEB6262,FF430101,FFA73C3C,FFD45354,FF4C0000,FFEB6262,FF3C0000,FFBC4A4A,FFBB4545,FF4C0000,FFEB6262,FF630000,FFE45C5C,FFAD2626,FFEB6262,FFF46C6C,FFB43535,FFEB6262,FF7B2323,0,FF130303,0
DATA 0,0,0,0,0,0,0,0,0,0,FF1D1D12,0,0,0,0,FF92403A,FFBB4545,FFD76565,FF8E4632,FF2F5724,FF357837,FF519C53,FF3E7C3F,0,0,0,FF174B1A,FF316B32,FF030B03,FF041304,FF1B0404,0,FF832525,FFE45C5C,FF2C0000,0,FF631313,FF3C0000,0,FF771B1B,FFE45C5C,FFD74C4C,FFEB6262,FF871314,FFD3565D,FFE45C5C,FFEB6262,FFBC4A4A,0,FFD45354,FFB44343,0,FFBB4545,FFEA5E5E,FF760000,FF832525,FFE45C5C,0,FFCC5151,FFB44343,FF771B1B,FFE45C5C,0,FFBC4A4A,FFD45354,FFB43535,FFEA5E5E,FFE45C5C,FFDB5555,FFD74C4C,FFC54C4C,FF9B2A29,FFDD5A5A,FF922E2E,0,FF1B0404,0,0
DATA 0,0,0,0,0,0,0,0,0,FF14140D,0,FF63501C,FFAC954A,FFB19A4C,FF63501C,FF801825,FFD3565D,FFCC5151,FFD76565,FFC44F58,FF340101,0,FF2A0827,FF323332,FF2C332C,FF323332,FF2A242C,FF0A040A,0,0,FF220B0B,0,FFA73C3C,FFDB5555,0,FF220B0B,0,FF4B1212,FF771B1B,FFA33636,FFE45C5C,FF340101,FFD45354,FFC64242,FFDB5555,FF760000,FFCC4C4C,FFA73C3C,0,FFE45C5C,FFAF2D2D,FFCC5151,0,FFB33C3B,FFDB5555,FFBA3C3C,FFDB5555,FF760000,FFF26665,FF630000,FF9A3434,FFDB5555,0,FF591313,FFDD5A5A,FFDD5A5A,FF760000,FFA73C3C,FF60110A,0,0,0,0,0,FF130303,0,0,0
DATA 0,0,0,0,0,0,0,0,FF14140D,0,FFB19A4C,FFDBC267,FFAC954A,FFDBC267,FFD19B59,FFD3565D,FFC7635C,FFC54E54,FFBB4545,FFD76565,FF713D38,FF002920,FF1D1D12,0,0,0,FF0C130C,FF323332,FF242424,0,FF220B0B,0,FFBC4A4A,FFC54C4C,0,FF2A0F10,0,FF9A3434,FFDB5555,FFC64242,FFC54C4C,0,FFDD5A5A,FFAF2D2D,FFE45C5C,FF3C0000,FFCC5151,FFBB4545,FF871314,FFE45C5C,FFC64242,FFFF7E7E,FFBA3C3C,FFD45354,FFC64242,FFCC4C4C,FFBA3C3C,FFE45C5C,FFB44343,0,FF591313,FF631313,0,0,FF130303,FF220202,0,0,0,FF0B0202,FF130303,FF1B0404,FF1D0A0A,FF1B0404,0,0,0,0
DATA 0,0,0,0,0,0,0,FF1C1B0C,0,FFAC954A,FFD5BC63,FF340E00,0,FFB19A4C,FFCAA853,FFB10025,FFD3565D,FFA65136,FFAD4341,FF9D494B,FF242424,FF0B0202,0,0,0,0,0,0,FF323332,FF1C1D1D,FF1B0404,0,FFCC5151,FFBB4545,0,FF381515,0,FFCC5151,FFBB4545,FFD74C4C,FFA73C3C,0,FFE45C5C,FFD45354,FFDD5A5A,0,FF6F1D1D,FFE45C5C,FFF26665,FFB43535,FFBA3C3C,FF9B2A29,FFD45354,FFC54C4C,FF340101,FF430101,FF1B0404,FF2C0000,0,FF0B0202,0,0,FF0B0202,FF130303,0,0,FF130303,FF220202,FF130303,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,FF130E03,0,FF746027,FFDBC267,FF2C0000,0,0,FF63501C,FFD5BC63,FFDBAE60,FFD19B59,FFCAA853,FF93803C,0,FF2F2723,0,0,0,0,0,0,0,FF131414,FF302F2F,FF1B0404,0,FFD45354,FFA73C3C,0,0,FF5B0101,FFEB6262,FF870000,FFE56161,FF832525,0,FFA33636,FFEB6262,FF8C2D2D,0,0,FF540000,FF832928,FF1B0404,0,0,0,0,0,0,0,0,FF1B0404,0,FF0B0202,FF130303,0,0,FF0B0202,FF0B0202,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,FF1C1B0C,0,FFC1AA5B,FFA28D44,0,FF221D0A,FF0C0A03,0,FF4E3804,FFA28D44,FF8A7730,FF9C843E,FFCDB45F,FF12001B,FF24221A,0,0,0,0,0,0,0,0,FF2B2B2B,FF2F2723,0,FFBC4A4A,FFDD5A5A,FF430101,FF6E1414,FFE85F60,FFB44343,0,FFBB4545,FF430101,0,0,FF130303,0,FF0A040A,FF130303,0,0,0,FF0B0202,FF1B0404,FF1D0A0A,FF1D0A0A,FF0B0202,FF0B0202,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,FF0C0A03,0,FF5C4715,FFD5BC63,FF3F2A00,0,0,0,FF130E03,0,0,0,FF63501C,FFCDB45F,FF3B2A21,FF14191D,0,0,0,0,0,0,0,0,FF1C1D1D,FF2B2B2B,0,FF3C0000,FFCC5151,FFE45C5C,FFE45C5C,FFB33C3B,0,FF0B0B0B,0,0,FF130E03,FF0B0202,0,FF1D150D,0,FF050812,FF14090C,FF1B0404,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,FF1C1B0C,0,FFA28D44,FFBCA454,0,FF1C1B0C,0,0,0,FF0B0202,FF2B2711,0,FF746027,FFCDB45F,FF2A0F10,FF242424,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF0B0202,0,0,FF580C0C,FF340101,0,FF14090C,0,0,FF1A1D22,0,FF35456D,FF6E7CA1,0,FF232D3F,0,0,FF050812,0,0,0,0,0,0,FF1C1D1D,FF1C1D1D,0,0,0,0,0,0,0,0,0,0,0,FF242424,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,FF130E03,FF000C0B,FF0B0202,FFD5BC63,FF746027,0,FF1A1506,0,0,0,0,FF1C1B0C,0,FF93803C,FFCAA853,0,FF34352F,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,0,FF14090C,0,0,FF1D0A0A,0,FF0C0A03,FF334161,FF000133,FF8192BC,FF788CC7,FF8A9ACA,FF8294C3,FF5B6A8B,FF000133,FF30394B,0,FF02040A,0,0,FF0B0B0B,FF0B0B0B,FF2B2B2B,FF242424,FF242424,FF2B2B2B,FF0B0B0B,FF0B0B0B,0,0,0,0,FF0B0B0B,0,FF1C1D1D,FF242424,FF2B2B2B,FF242424,FF2B2B2B,0,FF131414,0,0,0,0,0
DATA 0,0,0,FF1E1805,FF131D0F,0,FFC1AA5B,FFBCA454,0,FF1C1B0C,0,0,0,0,0,FF1C1B0C,0,FFBCA454,FFAC954A,0,FF393837,FF0B0B0B,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF2B2B2B,0,0,0,0,FF232D3F,FF000133,FF8A9ACA,FF475677,FF475677,FF99ABDC,FFA1B5EA,FF8192BC,0,FF8A9ACA,FF3C5288,FF000133,FF0D1522,0,0,FF2B2B2B,0,FF1C1D1D,FF323332,FF323332,FF1C1D1D,0,FF2B2B2B,0,0,0,0,FF131414,FF2B2B2B,0,FF2B2B2B,FF323332,FF323332,FF0B0B0B,FF1C1D1D,FF2B2B2B,0,FF0B0B0B,0,0,0
DATA 0,0,0,0,0,FFBCA454,FFCDB45F,0,FF000C0B,0,0,0,0,0,FF0B0202,0,FF3F2A00,FFD5BC63,FF5C4715,0,FF242424,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,FF242424,FF1A1D22,0,FF475677,FF8A9ACA,FF889CD6,FF6276AB,0,FF5C6B94,FF90A2D3,0,FF00104A,FF8FA4DC,FF7F93CC,FF7084B8,0,FF242424,FF2B2B2B,FF2B2B2B,FF131414,0,FF242424,FF242424,0,FF131414,FF2B2B2B,FF2B2B2B,FF1C1D1D,0,FF2B2B2B,FF242424,FF2B2B2B,0,0,FF2B2B2B,FF131414,0,FF242424,FF2B2B2B,FF2B2B2B,FF0B0B0B,0,0,0
DATA 0,0,FF3F2A00,FF7D6628,FFCDB45F,FFC1AA5B,FF1B0404,FF030B03,FF130E03,0,0,0,0,0,FF1C1B0C,0,FFAC954A,FFBCA454,0,FF1C1B0C,0,FF2B2B2B,FF131414,0,0,0,0,0,0,0,0,0,0,FF242424,FF393837,FF242424,0,FF162C54,FF788CC7,FFA1B5EA,FF8FA4DC,FF35456D,FF516089,FF8A9ACA,FF000133,FF798BB7,FFA1B5EA,FF98ACE3,FF445992,0,FF0C0E13,FF2B2B2B,FF323332,FF2B2B2B,0,FF242424,FF242424,0,FF2B2B2B,FF323332,FF2B2B2B,FF0B0B0B,0,FF131414,FF323332,FF323332,FF242424,0,FF2B2B2B,FF0B0B0B,FF131414,FF323332,FF323332,FF242424,0,0,0,0
DATA FF1C1B0C,0,FFA28D44,FFFCE689,FFD7B855,FF4A0D00,0,0,FF0C130C,0,0,0,0,FF0C0A03,0,FF340E00,FFD5BC63,FF63501C,0,FF130E03,0,FF1C1D1D,FF2B2B2B,0,0,0,0,0,0,0,FF0B0B0B,FF242424,FF323332,FF242424,0,FF050812,0,FF516089,FF8294C3,FF3C5288,FF5C6B94,FF90A2D3,FF7F93CC,FF889CD6,FF889CD6,FF8192BC,FF1E3D7B,FF7182AD,FF798BB7,FF000026,FF24221A,FF2A242C,FF0B0B0B,FF242424,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF242424,FF0B0B0B,FF242424,FF242424,0,FF2B2B2B,FF1C1D1D,FF0B0B0B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF131414,FF131414,FF2B2B2B,FF131414,0,0,0
DATA 0,0,FF301F00,FF7D6628,FFBCA454,FFD5BC63,FFBCA454,FF7D6628,0,0,FF0C0A03,FF1D1D12,FF130E03,FF1C1B0C,0,FF93803C,FFC1AA5B,0,FF1C1B0C,0,0,FF0B0B0B,FF2B2B2B,0,0,0,0,0,0,FF242424,FF323332,FF242424,0,0,0,0,0,FF162C54,FF00104A,0,0,FF6276AB,FF8FA4DC,FF6A86CE,FF889CD6,FF000133,0,FF000026,FF1F325B,FF0D1522,0,0,0,0,FF242424,FF2B2B2B,FF2B2B2B,FF242424,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF242424,FF2B2B2B,FF131414,0,0,0,0,0,0,0
DATA 0,0,0,0,0,FF4E3804,FFA28D44,FFD5BC63,FFCDB45F,FF301F00,FF02040A,0,0,FF262B0C,0,FFBCA454,FFA28D44,0,FF1A1506,0,0,0,FF2B2B2B,FF0B0B0B,0,0,FF0B0B0B,FF131414,0,FF2B2B2B,FF242424,0,0,0,0,FF111319,0,FF5C6B94,FF90A2D3,FF788CC7,FF8A9ACA,FF90A2D3,FF7084B8,FF8A9ACA,FF7084B8,FF99ABDC,FF7084B8,FF90A2D3,FF8192BC,FF001032,FF24221A,FF2F2F31,FF242424,FF2B2B2B,FF242424,FF242424,FF242424,FF2B2B2B,FF2B2B2B,FF242424,FF2B2B2B,FF242424,0,FF2B2B2B,FF2B2B2B,FF242424,FF323332,FF242424,FF2B2B2B,FF1C1D1D,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF1C1D1D,0,0,0
DATA 0,0,FF0B0202,FF1A1506,FF1C1B0C,0,0,FF8A7730,FFD5BC63,0,FF3F2A00,FFC1AA5B,FF7D6628,0,0,FFC1AA5B,FF9C843E,0,FF1A1506,0,0,0,FF2B2B2B,0,0,FF242424,FF323332,FF323332,FF131414,FF2B2B2B,FF242424,0,0,0,0,FF02040A,FF0B0202,FF000040,FF788CC7,FFA1B5EA,FF7F93CC,0,FF516089,FF8A9ACA,0,FF445992,FFA1B5EA,FF8FA4DC,FF3C5288,0,FF111319,FF2B2B2B,FF323332,FF1C1D1D,0,FF242424,FF242424,0,FF242424,FF323332,FF2B2B2B,0,0,FF131414,FF323332,FF323332,FF0B0B0B,0,FF2B2B2B,FF0B0B0B,0,FF2B2B2B,FF323332,FF242424,0,0,0,0
DATA 0,0,0,0,0,FF1A1506,0,FF746027,FFD5BC63,FF77570B,FFC1AA5B,FFDBC267,FFCDB45F,FFCDB45F,FF654703,FFB19A4C,FFA28D44,0,FF1A1506,0,0,FF0B0B0B,FF2B2B2B,FF1C1D1D,FF323332,FF242424,0,FF131414,FF2B2B2B,FF242424,0,0,0,0,0,FF0C0E13,0,FF475677,FF7182AD,FF7F93CC,FF6E7CA1,0,FF6276AB,FF90A2D3,0,FF001032,FF90A2D3,FF687CB3,FF6E7CA1,0,FF242424,FF1C1D1D,FF2B2B2B,FF131414,0,FF2B2B2B,FF242424,0,FF131414,FF2B2B2B,FF1C1D1D,FF1C1D1D,0,FF242424,FF1C1D1D,FF2B2B2B,0,0,FF2B2B2B,FF131414,0,FF242424,FF242424,FF242424,FF131414,0,0,0
DATA 0,0,0,0,0,0,FF130E03,0,FF9C843E,FFD5BC63,FFBCA454,FF130303,FF1B0404,FFA28D44,FFCDB45F,FFE8CD6C,FFCDB45F,0,FF1C1B0C,0,0,FF1C1D1D,FF393837,FF242424,FF0B0B0B,0,0,0,0,0,0,0,0,0,0,0,FF02040A,0,0,FF7182AD,FF162C54,FF6E7CA1,FF98ACE3,FF98ACE3,FF8A9ACA,FF000026,FF6E7CA1,FF334161,0,FF1A1D22,0,0,FF242424,0,FF242424,FF323332,FF323332,FF242424,0,FF242424,0,0,0,0,FF131414,FF242424,0,FF2B2B2B,FF323332,FF323332,FF131414,FF0B0B0B,FF242424,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0C0A03,0,0,0,FF000C0B,FF000C0B,0,FF1B0404,FFAC954A,FFC1AA5B,0,FF000C0B,0,0,FF131414,FF131414,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1A1D22,0,FF001032,FF8192BC,FF687CB3,FF7F93CC,FF687CB3,FF5B6A8B,0,FF111319,FF14191D,0,0,0,0,FF131414,FF242424,FF242424,FF242424,FF242424,FF0B0B0B,0,0,0,0,0,0,0,FF242424,FF1C1D1D,FF2B2B2B,FF1C1D1D,FF242424,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF1D150D,FF0C130C,FF1C1B0C,FF0B0202,FF0B0202,FF1C1B0C,FF02040A,0,0,FF0B0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0B0B,FF14191D,0,FF334161,FF5C6B94,0,FF02040A,FF111319,0,0,0,0,0,0,0,0,FF1C1D1D,FF131414,0,0,0,0,0,0,0,0,0,0,0,FF1C1D1D,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1C1B0C,FF14140D,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF131414,0,0,FF1C1D1D,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF02040A,FF131414,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
frame2:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF130303,FF0F0B02,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1B0404,FF0B0302,0,FF0B0302,0,0,FF0B0302,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF130303,FF0B0302,0,FF0B0302,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1B0404,0,FF9A3434,FFC54C4C,0,FF130303,0,0,0,0,0,FF0B0302,0,0,FF130303,FF1B0404,FF1B0404,FF130303,FF0B0302,0,0,FF130303,0,0,FF0B0302,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF771B1B,FF3C0000,FF010B0B,0,FFEE6D6D,FFD76565,0,FF1C140E,FF130303,0,0,FF1D0A0A,FF1B0404,FF0C0B0B,0,FF130303,0,0,0,0,0,FF631313,FF4B1212,0,FFA43B3B,FFBB4545,0,FF1D0A0A,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0B1A0B,FF0C130C,0,0,0,FF0B1A0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0302,FF010B0B,FF2C0000,FFEB6262,FF9A3434,0,FF8D211F,FFFF7E7E,FFB44343,0,FF2A0F10,0,0,FF0B0302,0,0,0,FF1B0404,0,FF7B2323,FF8D211F,FF9A3434,FFAD4341,0,FFE45C5C,FF8C2D2D,0,FFF46C6C,FFBC4A4A,0,FF220B0B,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF0B040A,FF0B1A0B,FF0C0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B1A0B,0,0,0,0,0,0,0,0,0,0,FF1B0404,0,FF5B0101,FFFF7E7E,FFBC4A4A,0,FFD45354,FFFD6B6B,FF9A3434,0,0,FF5B0101,FF220202,FF1B0404,FFB44343,FF9B2A29,FFD45354,FF6F1D1D,0,FFBC4A4A,FFF26665,FFFA7272,FFB54A48,FF4C0000,FFF46C6C,FF5B0101,FF8C2D2D,FFFA7272,FF540000,0,FF130303,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF021F00,FF3E7C3F,FF316B32,0,0,0,FF438645,FF143C15,0,FF0B1A0B,0,0,0,0,0,0,0,0,0,FF030B03,0,0,0,0,0,FF030B03,0,0,0,0,0,FF1B0404,0,FF832525,FFFA7272,FFCC5151,FF871314,FFE45C5C,FFE15555,FF8C2D2D,0,FFBB4545,FFF26665,FFC54C4C,FF630000,FFF46C6C,FFEB6262,FFEE6D6D,FF430101,0,FFDD5A5A,FFAF2D2D,FFDB5555,FF7B2323,FF832525,FFF46C6C,0,FFC54C4C,FFD45354,0,FF1D0A0A,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0C0B0B,0,FF78CC7A,FF71CC73,FF5CB35D,FF3E7C3F,FF4B994D,FF83DD84,FF2A642C,0,0,0,0,0,0,FF041304,0,0,FF0C130C,FF030B03,FF030B03,FF539452,FF143C15,0,FF131D0F,FF131413,0,0,0,0,0,FF220B0B,FF2A0F10,0,FFAD4341,FFE15555,FFD74C4C,FFD45354,FFC64242,FFDD5A5A,FF6E1414,FF9A3434,FFE45C5C,FFAD2626,FFE45C5C,FFAF2D2D,FFD45354,FFAD2626,FFD45354,0,FF7B2323,FFEB6262,FF6B0000,FFE45C5C,FF540000,FFB54A48,FFFF7E7E,FF870000,FFFA7272,FFA93D3D,0,FF1D0A0A,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF041304,0,FF2A642C,FF5CB35D,FF186C1C,FF63BC65,FF56A358,FF52AC54,FF357837,FF003000,FF61AC62,FF0B300C,0,FF030B03,0,0,0,FF0B1A0B,0,0,FF205422,FF88E38A,FF357837,0,0,0,FF003B00,FF0B1A0B,0,FF0B0302,0,0,0,0,FFD45354,FFB43535,FFDD5A5A,FFFA7272,FF870000,FFE56161,FF630000,FFDD5A5A,FFAF2D2D,FFE45C5C,FFB43535,FFDB5555,FFA33636,FFB33C3B,FFCC5151,0,FFDD5A5A,FFBB4545,0,FFE56161,FFBA3C3C,FFE45C5C,FFE45C5C,FFE45C5C,FFF46C6C,FFA93D3D,0,FF1D0A0A,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF131413,0,FF66C069,FF3E7C3F,FF003000,FF003000,FF438645,FF6CC66D,FF63BC65,FF7CD47D,FF114713,0,FF030B03,0,FF2A642C,0,FF021F00,FF71C373,FF014803,FF519C53,FF5EBA60,FF5AAC5C,FF316B32,FF4B994D,FF71C373,FF71C373,0,FF14140D,0,FF220202,FFB44343,FF832928,FF340101,FFEB6262,FF630000,FFAD4341,FFBC4A4A,FF5B0101,FFE45C5C,FF5B0101,FFDB5555,FFE15555,FFBA3C3C,FFAF2D2D,FFEB6262,0,FF9A3434,FFEA5E5E,FFCC4C4C,FFDD5A5A,FF220202,0,FF922E2E,FFE45C5C,FFB33C3B,FFA31D1D,FFC64242,FFC64242,FFBC4A4A,0,FF220B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0C130C,0,FF71C373,FF7CD47D,FF005700,FF316B32,FF62B464,FF003B00,FF5AAC5C,FF278532,FF52AC54,0,0,FF1C1C1C,0,FF71CC73,FF62B464,FF005700,FF71CC73,FF6CC66D,FF66C069,FF003000,FF66C069,FF5CB35D,FF52AC54,FF76D77A,FF316B32,0,FF1C1B0C,0,FFCC4C4C,FFE45C5C,FF430101,FF9A3434,FFE45C5C,0,0,0,FF4A0D00,FFEB6262,FFAF2D2D,FFE15555,FFDB5555,FFB33C3B,FFF26665,FF832525,0,FF220202,FFB44343,FFC54C4C,FF430101,0,FF1B0404,0,0,FF630000,FFF26665,FF8D211F,FFC54C4C,FFBC4A4A,0,FF220B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF2A642C,FF429544,FF71CC73,FF3C893E,FF5CB35D,FF3B733A,0,FF5AAC5C,FF5EBA60,FF3C893E,FF3E7C3F,0,0,FF5CB35D,FF52AC54,FF73D375,FF4B994D,FF498A4A,FF3B733A,0,0,FF003000,FF6BBE6D,FF316B32,0,FF131D0F,0,FF4C0000,FFEB6262,FF4C0000,0,FFEA5E5E,FFA33636,0,FF28201C,FF130303,0,FFBB4545,FFE45C5C,FF8D211F,FFBC4A4A,FFCD3448,FF6B0000,0,FF1D0A0A,0,0,0,0,FF130303,0,FF2A0F10,0,FFC54C4C,FFC54C4C,0,FFDD5A5A,FFA43B3B,0,FF220B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF030B03,0,FF003000,FF459D48,FF63BC65,FF316B32,FF357837,FF63BC65,0,FF61AC62,FF5AAC5C,FF73D375,FF52A454,FF5AAC5C,FF52A454,FF5CB35D,FF003000,FF61AC62,FF3E7C3F,0,FF438645,FF63BC65,FF2B762D,FF6CC66D,FF368538,0,FF1F2917,0,FF0C0B0B,0,FFD45354,FFD45354,FFDB5555,FFD45354,0,0,0,FF316B32,FF174B1A,0,FF041304,0,0,FF038140,FF3A8C4C,FF021F00,FF0B1A0B,FF131D0F,FF1C0709,FF2A0F10,FF4C0000,FF0B0302,0,FF220B0B,0,FFC54C4C,FFD45354,FFA83232,FFEB6262,FF4C0000,0,FF130303,FF0B0302,0,0,FF130303,FF220B0B,FF0B0302,0,0,0
DATA 0,0,0,0,0,0,0,FF0B1A0B,0,FF56A358,FF83DD84,FF429544,0,0,FF62B464,FF438645,0,FF021F00,FF63BC65,FF003000,FF62B464,FF73D375,FF71CC73,0,0,FF357837,FF66C069,FF5CB35D,FF014803,FF519C53,FF71CC73,FF5EBA60,FF7CD47D,FF003000,0,FF1D0A0A,0,FF430101,FFB44343,FFA93D3D,FF0B0302,0,FF316B32,FF71C373,FF83DD84,FF80D381,0,0,FF3B733A,FF80D381,FF71CC73,FF88E38A,FF498A4A,0,0,FF030B03,FF631313,FFD45354,FF340101,0,FF130303,0,FF580C0C,FFD45354,FFDD5A5A,FF771B1B,0,FF2A0F10,FF130303,0,0,FF130303,0,0,0,FF0B0302,0,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,FF205422,FF52A454,FF71CC73,FF3B733A,FF114713,FF6CC66D,0,FF438645,FF5AAC5C,0,FF5CB35D,FF2B762D,FF205422,FF003B00,FF62B464,FF63BC65,FF2A642C,0,0,0,FF459D48,FF71CC73,FF498A4A,0,FF1C140E,0,0,FF010B0B,0,0,FF021810,0,FF519C53,FF429544,FF71C373,FF6AB36B,0,FF62B464,FF88E38A,FF498A4A,FF014803,FF80D381,FF005700,FF438645,FF539452,0,FF832928,FFD45354,0,FF0C0B0B,FF1B0404,FF1B0404,0,0,0,0,FF010B0B,0,0,FF2C0000,FF1B0404,0,FF631313,FFB44343,FF580C0C,0,FF0B0302,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF3C893E,FF6CC66D,FF357837,0,FF519C53,FF5AAC5C,FF005700,FF4B994D,FF2B762D,FF66C069,0,FF357837,FF6CC66D,FF498A4A,0,0,0,FF498A4A,FF63BC65,FF52A454,FF114713,0,FF1C140E,0,FF130303,FF4C0000,0,FF1D0A0A,FF1B0404,FF220202,FF62211A,0,FF2A642C,FF80D381,FF014803,FF78CC7A,FF78CC7A,FF003B00,0,FF205422,FF80D381,FF78CC7A,FF7CD47D,FF438645,FF540000,FFB33C3B,FFD24545,FFB33C3B,FF340101,0,0,0,0,FF010B0B,0,FF3C0000,FFBC4A4A,FFB33C3B,FFCC4C4C,0,FF631313,FFDB5555,FFFD6B6B,FF9A3434,0,FF220202,0
DATA 0,0,0,0,0,0,0,0,FF0B1A0B,0,FF539452,FF88E38A,FF52AC54,FF5AAC5C,FF174B1A,0,FF5AAC5C,FF52AC54,FF6CC66D,FF63BC65,FF5AAC5C,FF52AC54,FF6CC66D,FF174B1A,0,FF0B300C,FF021F00,0,FF52A454,FF73D375,FF56A358,FF205422,FF1B0404,0,FF832525,FFE45C5C,FFEA5E5E,FFBB4545,0,0,FF832525,FFCC5151,0,FF528E51,FF83DD84,FF7CD47D,FF6AB36B,0,0,FF1F2917,0,FF2A642C,FF498A4A,0,0,FF8C2D2D,FFD74C4C,FFC64242,FFA33636,FF630000,FF7B2323,FF6E1414,FF8C2D2D,FFBC4A4A,FF580C0C,0,FFCC5151,FFDB5555,FFD24545,FFDD5A5A,0,FFBC4A4A,FFE45C5C,FF760000,FF551913,0,FF0B0302,0
DATA 0,0,0,0,0,0,0,0,0,0,FF0B300C,FF003000,FF52AC54,FF76D77A,FF3C893E,FF498A4A,FF278532,FF66C069,FF6CC66D,0,FF63BC65,FF52A454,0,0,0,FF4B994D,FF78CC7A,FF5CB35D,FF5CB35D,FF63BC65,FF80D381,FF3E7C3F,0,FF60110A,FFEB6262,FFA33636,FF5B0101,FFEA5E5E,FF9A3434,0,FFBB4545,FFC54C4C,0,FF152600,FF6AB36B,FF539452,0,0,FF14140D,0,0,0,0,FF7B2323,FF62211A,0,FFCC4C4C,FFA33636,0,FFDB5555,FFD74C4C,FFEB6262,FFD24545,FFE45C5C,FFC54C4C,FF3C0000,FFEB6262,FF3C0000,FFB44343,FFCC4C4C,0,FF540000,FFDD5A5A,FFD45354,FF1B0404,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0B1A0B,0,FF3B733A,FF88E38A,FF5EBA60,FF5AAC5C,FF459D48,FF83AF61,FF6FAC58,FF006A08,FF62B464,FF459D48,FF368538,FF5AAC5C,FF5AAC5C,FF519C53,FF429544,FF6CC66D,FF3C893E,FF205422,FF114713,0,FF0B0302,0,FFCC4C4C,FFC54C4C,0,0,FFDB5555,FFB44343,0,FFDB5555,FF9A3434,0,FF2A0F10,0,0,FF551913,FF9A3434,0,FF62211A,FF8C2D2D,0,FFB54A48,FFFD6B6B,FFD3565D,0,FFE45C5C,FF8C2D2D,FF6E1414,FFEB6262,FF6B0000,FFE56161,FF6B0000,FFA93D3D,FFCC5151,FF6B0000,FFE45C5C,FF1B0404,FFD45354,FF9B2A29,FFA33636,FFB44343,0,FFE45C5C,FFA93D3D,0,FF220202,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,0,FF2F5724,FF3B733A,FF242E03,0,FF86002F,FFD3565D,FFC54E54,FF5C934D,FF76D77A,FF459D48,FF88E38A,FF63BC65,FF2B762D,FF4B994D,FF52A454,FF71CC73,FF6BBE6D,0,FF0B0302,FF1D1D12,FF00160D,FF430101,FFEB6262,FF771B1B,0,FFB33C3B,FFE45C5C,FF430101,FF2C0000,FFE45C5C,FF9B2A29,FF580C0C,0,FFB54A48,FFC54C4C,FFE56161,FFE56161,0,FFBB4545,FFCC5151,FF4C0000,FFF46C6C,FFAF2D2D,FFBB4545,FF540000,FFEB6262,FF430101,FFA43B3B,FFD45354,FF4C0000,FFEB6262,FF3C0000,FFBC4A4A,FFBB4545,FF4C0000,FFEB6262,FF630000,FFE45C5C,FFAD2626,FFEB6262,FFF46C6C,FFB43535,FFEB6262,FF7B2323,0,FF130303,0
DATA 0,0,0,0,0,0,0,0,0,0,FF1D1D12,0,0,0,0,FF92403A,FFBB4545,FFD76565,FF8E4632,FF2F5724,FF357837,FF519C53,FF3E7C3F,0,0,0,FF174B1A,FF316B32,FF030B03,FF041304,FF1B0404,0,FF832525,FFE45C5C,FF2C0000,0,FF631313,FF3C0000,0,FF771B1B,FFE45C5C,FFD74C4C,FFEB6262,FF871314,FFD3565D,FFE45C5C,FFEB6262,FFBC4A4A,0,FFD45354,FFB44343,0,FFBB4545,FFEA5E5E,FF760000,FF832525,FFE45C5C,0,FFCC5151,FFB44343,FF771B1B,FFE45C5C,0,FFBC4A4A,FFD45354,FFB43535,FFEA5E5E,FFE45C5C,FFDB5555,FFD74C4C,FFC54C4C,FF9B2A29,FFDD5A5A,FF922E2E,0,FF1B0404,0,0
DATA 0,0,0,0,0,0,0,0,0,FF14140D,0,FF63501C,FFAC954A,FFB19A4C,FF63501C,FF801825,FFD3565D,FFCC5151,FFD76565,FFC44F58,FF340101,0,FF2A0827,FF323232,FF2C332C,FF323232,FF2D212D,FF0B040A,0,0,FF220B0B,0,FFA43B3B,FFDB5555,0,FF220B0B,0,FF4B1212,FF771B1B,FFA33636,FFE45C5C,FF340101,FFD45354,FFC64242,FFDB5555,FF760000,FFCC4C4C,FFA43B3B,0,FFE45C5C,FFAF2D2D,FFCC5151,0,FFB33C3B,FFDB5555,FFBA3C3C,FFDB5555,FF760000,FFF26665,FF630000,FF9A3434,FFDB5555,0,FF591313,FFDD5A5A,FFDD5A5A,FF760000,FFA43B3B,FF60110A,0,0,0,0,0,FF130303,0,0,0
DATA 0,0,0,0,0,0,0,0,FF14140D,0,FFB19A4C,FFDBC267,FFAC954A,FFDBC267,FFD19B59,FFD3565D,FFC7635C,FFC54E54,FFBB4545,FFD76565,FF713D38,FF002920,FF1D1D12,0,0,0,FF0C130C,FF323232,FF242424,0,FF220B0B,0,FFBC4A4A,FFC54C4C,0,FF2A0F10,0,FF9A3434,FFDB5555,FFC64242,FFC54C4C,0,FFDD5A5A,FFAF2D2D,FFE45C5C,FF3C0000,FFCC5151,FFBB4545,FF871314,FFE45C5C,FFC64242,FFFF7E7E,FFBA3C3C,FFD45354,FFC64242,FFCC4C4C,FFBA3C3C,FFE45C5C,FFB44343,0,FF591313,FF631313,0,0,FF130303,FF220202,0,0,0,FF0B0302,FF130303,FF1B0404,FF1D0A0A,FF1B0404,0,0,0,0
DATA 0,0,0,0,0,0,0,FF1C1B0C,0,FFAC954A,FFD5BC63,FF340E00,0,FFB19A4C,FFCAA853,FFB10025,FFD3565D,FFA65136,FFAD4341,FF9D494B,FF242424,FF0B0302,0,0,0,0,0,0,FF323232,FF1C1C1C,FF1B0404,0,FFCC5151,FFBB4545,0,FF381515,0,FFCC5151,FFBB4545,FFD74C4C,FFA93D3D,0,FFE45C5C,FFD45354,FFDD5A5A,0,FF6F1D1D,FFE45C5C,FFF26665,FFB43535,FFBA3C3C,FF9B2A29,FFD45354,FFC54C4C,FF340101,FF430101,FF1B0404,FF2C0000,0,FF0B0302,0,0,FF0B0302,FF130303,0,0,FF130303,FF220202,FF130303,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,FF141105,0,FF746027,FFDBC267,FF2C0000,0,0,FF63501C,FFD5BC63,FFDBAE60,FFD19B59,FFCAA853,FF93803C,0,FF2F2723,0,0,0,0,0,0,0,FF131413,FF302F2F,FF1B0404,0,FFD45354,FFA93D3D,0,0,FF5B0101,FFEB6262,FF870000,FFE56161,FF832525,0,FFA33636,FFEB6262,FF8C2D2D,0,0,FF540000,FF832928,FF1B0404,0,0,0,0,0,0,0,0,FF1B0404,0,FF0B0302,FF130303,0,0,FF0B0302,FF0B0302,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,FF1C1B0C,0,FFC1AA5B,FFA28D44,0,FF221D0A,FF0F0B02,0,FF4E3804,FFA28D44,FF8A7730,FF9C843E,FFCDB45F,FF12001B,FF28201C,0,0,0,0,0,0,0,0,FF2B2B2C,FF2F2723,0,FFBC4A4A,FFDD5A5A,FF430101,FF6E1414,FFE85F60,FFB44343,0,FFBB4545,FF430101,0,0,0,0,FF0B0302,FF130303,0,0,0,FF0B0302,FF1B0404,FF1D0A0A,FF1D0A0A,FF0B0302,FF130B0C,FF0C0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,FF0F0B02,0,FF5C4715,FFD5BC63,FF3F2A00,0,0,0,FF141105,0,0,0,FF63501C,FFCDB45F,FF3B2A21,FF15191C,0,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2C,0,FF3C0000,FFCC5151,FFE45C5C,FFE45C5C,FFB33C3B,0,FF0C0B0B,0,0,0,FF130303,0,FF130303,0,0,FF130303,FF1B0404,0,0,0,FF0B0C13,0,FF141105,0,0,FF0F0B02,0,FF0B0C13,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,FF1C1B0C,0,FFA28D44,FFBCA454,0,FF1C1B0C,0,0,0,FF0B0302,FF2B2711,0,FF746027,FFCDB45F,FF2A0F10,FF242424,0,0,0,0,0,0,0,0,0,FF2B2B2C,FF0B0302,0,0,FF580C0C,FF340101,0,FF130B0C,0,FF130303,0,0,FF0C0B0B,FF242424,0,0,0,0,0,0,FF02040B,0,0,FF212937,0,FF53668D,FF53668D,0,FF212937,0,0,FF02040B,0,0,0,0,0,0,FF242424,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,FF0F0B02,FF010B0B,FF0B0302,FFD5BC63,FF746027,0,FF1A1506,0,0,0,0,FF1C1B0C,0,FF93803C,FFCAA853,0,FF34352F,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2C,0,FF130B0C,0,0,FF1D0A0A,0,0,FF130B0C,0,FF2B2B2C,FF242424,FF242424,FF2B2B2C,FF1C1C1C,0,FF0C0B0B,0,FF02040B,0,FF212937,FF233253,FF334260,FF8293C0,FF788EC8,FF7188C1,FF889BCC,FF334260,FF233253,FF212937,0,FF02040B,0,FF0C0B0B,0,FF1C1C1C,FF242424,FF2B2B2C,FF242424,FF2B2B2C,0,FF131413,0,0,0,0,0
DATA 0,0,0,FF1E1805,FF131D0F,0,FFC1AA5B,FFBCA454,0,FF1C1B0C,0,0,0,0,0,FF1C1B0C,0,FFBCA454,FFAC954A,0,FF393837,FF0C0B0B,0,0,0,0,0,0,0,0,0,FF2B2B2C,FF2B2B2C,0,0,0,0,FF0C0B0B,0,FF2B2B2C,FF131413,FF131413,FF323232,FF323232,FF2B2B2C,0,FF2B2B2C,FF131413,0,0,FF212937,FF052863,FF8FA2D4,FF000040,FF6C7DA8,FF96ACE5,FF96ACE5,FF66769D,FF00224F,FF8FA2D4,FF000459,FF212937,0,0,FF131413,FF2B2B2C,0,FF2B2B2C,FF323232,FF323232,FF0C0B0B,FF1C1C1C,FF2B2B2C,0,FF0C0B0B,0,0,0
DATA 0,0,0,0,0,FFBCA454,FFCDB45F,0,FF010B0B,0,0,0,0,0,FF0B0302,0,FF3F2A00,FFD5BC63,FF5C4715,0,FF242424,FF2B2B2C,0,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2C,FF242424,FF131413,0,FF131413,FF2B2B2C,FF2B2B2C,FF1C1C1C,0,FF1C1C1C,FF2B2B2C,0,0,FF2B2B2C,FF242424,FF2B2B2C,0,FF66769D,FF8196CB,FF8FA2D4,FF445476,0,FF7188C1,FF7188C1,0,FF4D5D83,FF8FA2D4,FF8196CB,FF617090,0,FF2D2E31,FF242424,FF2B2B2C,0,0,FF2B2B2C,FF131413,0,FF242424,FF2B2B2C,FF2B2B2C,FF0C0B0B,0,0,0
DATA 0,0,FF3F2A00,FF7D6628,FFCDB45F,FFC1AA5B,FF1B0404,FF030B03,FF0F0B02,0,0,0,0,0,FF1C1B0C,0,FFAC954A,FFBCA454,0,FF1C1B0C,0,FF2B2B2C,FF131413,0,0,0,0,0,0,0,0,0,0,FF242424,FF393837,FF242424,0,0,FF242424,FF323232,FF2B2B2C,FF0C0B0B,FF131413,FF2B2B2C,0,FF242424,FF323232,FF2B2B2C,FF11151D,0,FF29437C,FF879CD6,FFA1B6ED,FF8196CB,FF000040,FF6B81B5,FF6C7DA8,FF000040,FF889BCC,FFA1B6ED,FF879CD6,FF1E386E,0,FF15191C,FF323232,FF323232,FF242424,0,FF2B2B2C,FF0C0B0B,FF131413,FF323232,FF323232,FF242424,0,0,0,0
DATA FF1C1B0C,0,FFA28D44,FFFCE689,FFD7B855,FF4A0D00,0,0,FF0C130C,0,0,0,0,FF0F0B02,0,FF340E00,FFD5BC63,FF63501C,0,FF141105,0,FF1C1C1C,FF2B2B2C,0,0,0,0,0,0,0,FF0C0B0B,FF242424,FF323232,FF242424,0,0,0,FF1C1C1C,FF2B2B2C,FF131413,FF1C1C1C,FF2B2B2C,FF242424,FF2B2B2C,FF2B2B2C,FF242424,FF0C0B0B,FF242424,FF2B2B2C,0,FF6C7DA8,FF7D8EB8,FF29437C,FF7283AD,FF8FA2D4,FF7A93D4,FF7A93D4,FF8FA2D4,FF6C7DA8,FF29437C,FF8293C0,FF66769D,0,FF2B2B2C,FF1B1E22,FF0C0B0B,FF2B2B2C,FF2B2B2C,FF2B2B2C,FF2B2B2C,FF2B2B2C,FF131413,FF131413,FF2B2B2C,FF131413,0,0,0
DATA 0,0,FF301F00,FF7D6628,FFBCA454,FFD5BC63,FFBCA454,FF7D6628,0,0,FF0F0B02,FF1D1D12,FF0F0B02,FF1C1B0C,0,FF93803C,FFC1AA5B,0,FF1C1B0C,0,0,FF0C0B0B,FF2B2B2C,0,0,0,0,0,0,FF242424,FF323232,FF242424,0,0,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2C,FF242424,FF2B2B2C,0,0,0,0,FF02040B,FF203359,FF000040,0,0,FF788EC8,FF7A93D4,FF7A93D4,FF7188C1,0,0,FF000040,FF233253,0,0,0,0,0,FF2B2B2C,FF242424,FF2B2B2C,FF131413,0,0,0,0,0,0,0
DATA 0,0,0,0,0,FF4E3804,FFA28D44,FFD5BC63,FFCDB45F,FF301F00,FF02040B,0,0,FF1F2917,0,FFBCA454,FFA28D44,0,FF1A1506,0,0,0,FF2B2B2C,FF0C0B0B,0,0,FF0C0B0B,FF131413,0,FF2B2B2C,FF242424,0,0,0,0,0,0,FF1C1C1C,FF2B2B2C,FF242424,FF2B2B2C,FF2B2B2C,FF242424,FF2B2B2C,FF242424,FF323232,FF242424,FF2B2B2C,FF2B2B2C,0,FF7283AD,FF8FA2D4,FF7188C1,FF8FA2D4,FF8293C0,FF788EC8,FF7188C1,FF8293C0,FF8FA2D4,FF7188C1,FF8FA2D4,FF6C7DA8,0,FF2B2B2C,FF2B2B2C,FF242424,FF323232,FF242424,FF2B2B2C,FF1C1C1C,FF2B2B2C,FF2B2B2C,FF2B2B2C,FF2B2B2C,FF1C1C1C,0,0,0
DATA 0,0,FF0B0302,FF1A1506,FF1C1B0C,0,0,FF8A7730,FFD5BC63,0,FF3F2A00,FFC1AA5B,FF7D6628,0,0,FFC1AA5B,FF9C843E,0,FF1A1506,0,0,0,FF2B2B2C,0,0,FF242424,FF323232,FF323232,FF131413,FF2B2B2C,FF242424,0,0,0,0,0,0,0,FF242424,FF323232,FF242424,0,FF131413,FF2B2B2C,0,FF131413,FF323232,FF2B2B2C,FF11151D,0,FF1E386E,FF879CD6,FFA1B6ED,FF6478AF,0,FF7788B2,FF6C7DA8,0,FF6B81B5,FFA1B6ED,FF879CD6,FF052863,0,FF15191C,FF323232,FF323232,FF0C0B0B,0,FF2B2B2C,FF0C0B0B,0,FF2B2B2C,FF323232,FF242424,0,0,0,0
DATA 0,0,0,0,0,FF1A1506,0,FF746027,FFD5BC63,FF77570B,FFC1AA5B,FFDBC267,FFCDB45F,FFCDB45F,FF654703,FFB19A4C,FFA28D44,0,FF1A1506,0,0,FF0C0B0B,FF2B2B2C,FF1C1C1C,FF323232,FF242424,0,FF131413,FF2B2B2C,FF242424,0,0,0,0,0,0,0,FF131413,FF242424,FF242424,FF1C1C1C,0,FF1C1C1C,FF2B2B2C,0,0,FF2B2B2C,FF1C1C1C,FF2B2B2C,0,FF617090,FF6478AF,FF879CD6,FF445476,0,FF8196CB,FF7188C1,0,FF4D5D83,FF879CD6,FF6478AF,FF617090,0,FF2B2B2C,FF1C1C1C,FF2B2B2C,0,0,FF2B2B2C,FF131413,0,FF242424,FF242424,FF242424,FF131413,0,0,0
DATA 0,0,0,0,0,0,FF141105,0,FF9C843E,FFD5BC63,FFBCA454,FF130303,FF1B0404,FFA28D44,FFCDB45F,FFE8CD6C,FFCDB45F,0,FF1C1B0C,0,0,FF1C1C1C,FF393837,FF242424,FF0C0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF242424,0,FF1C1C1C,FF323232,FF323232,FF2B2B2C,0,FF242424,FF0C0B0B,0,FF0E1016,0,FF00002E,FF7788B2,FF00002E,FF8293C0,FF96ACE5,FF96ACE5,FF7788B2,FF00002E,FF7788B2,FF02040B,0,FF11151D,0,FF131413,FF242424,0,FF2B2B2C,FF323232,FF323232,FF131413,FF0C0B0B,FF242424,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0F0B02,0,0,0,FF010B0B,FF010B0B,0,FF1B0404,FFAC954A,FFC1AA5B,0,FF010B0B,0,0,FF131413,FF131413,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF2B2B2C,FF1C1C1C,FF242424,FF242424,FF1C1C1C,0,0,0,0,FF0B0C13,FF1B1E22,0,FF445476,FF7788B2,FF7188C1,FF7188C1,FF7788B2,FF334260,0,FF1B1E22,FF0C0B0B,0,0,0,0,FF242424,FF1C1C1C,FF2B2B2C,FF1C1C1C,FF242424,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF1C140E,FF0C130C,FF1C1B0C,FF0B0302,FF0B0302,FF1C1B0C,FF02040B,0,0,FF0C0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0C0B0B,FF1C1C1C,0,0,0,0,0,0,0,0,FF131413,FF11151D,0,FF4D5D83,FF445476,0,FF11151D,FF131413,0,0,0,0,0,0,0,0,FF1C1C1C,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1C1B0C,FF14140D,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,0,0,FF1C1C1C,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0C13,FF0B0C13,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
frame3:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF131413,0,0,0,FF3B3B3B,FF343434,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF131413,FF0B0B0B,0,FF242424,FF2B2B2B,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0C1A0C,FF0B130B,0,0,0,FF0C1A0C,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF3B3B3B,FF1C1C1C,0,FF131413,FF414241,FF242424,0,0,0,0,0,0,0,0,0,0,FF131413,FF1C1C1C,FF1C1C1C,FF242424,0,FF343434,FF1C1C1C,0,FF3B3B3B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF090408,FF0C1A0C,FF0B0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0C1A0C,0,0,0,0,0,0,0,0,0,0,0,0,0,FF414241,FF2B2B2B,0,FF2B2B2B,FF3B3B3B,FF1C1C1C,0,0,FF0B0B0B,0,0,FF242424,FF1C1C1C,FF343434,FF131413,0,FF2B2B2B,FF3B3B3B,FF3B3B3B,FF242424,0,FF3B3B3B,0,FF1C1C1C,FF3B3B3B,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF002300,FF407C42,FF326C34,0,0,0,FF448A46,FF143C15,0,FF0C1A0C,0,0,0,0,0,0,0,0,0,FF030B03,0,0,0,0,0,FF030B03,0,0,0,0,0,0,0,FF131413,FF3B3B3B,FF2B2B2B,FF0B0B0B,FF343434,FF343434,FF1C1C1C,0,FF2B2B2B,FF3B3B3B,FF2B2B2B,0,FF3B3B3B,FF3B3B3B,FF3B3B3B,0,0,FF343434,FF1C1C1C,FF343434,FF131413,FF131413,FF3B3B3B,0,FF2B2B2B,FF343434,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0B0B0B,0,FF78CC7A,FF6FCB72,FF5FB661,FF3B7B3D,FF4C9E4E,FF82DD84,FF2C642D,0,0,0,0,0,0,FF031303,0,0,FF0B130B,FF030B03,FF030B03,FF4D934F,FF143C15,0,FF122413,FF131413,0,0,0,0,0,0,0,0,FF242424,FF343434,FF2B2B2B,FF343434,FF2B2B2B,FF343434,FF0B0B0B,FF1C1C1C,FF343434,FF1C1C1C,FF343434,FF1C1C1C,FF343434,FF1C1C1C,FF343434,0,FF131413,FF343434,0,FF343434,0,FF242424,FF3B3B3B,0,FF3B3B3B,FF242424,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF031303,0,FF266328,FF5BB35D,FF186C1C,FF63BB65,FF54A456,FF53AC54,FF357736,FF002E00,FF61AD62,FF08350A,0,FF030B03,0,0,0,FF0C1A0C,0,0,FF1D5B20,FF88E48A,FF357736,0,0,0,FF003B00,FF0C1A0C,0,0,0,0,0,0,FF343434,FF242424,FF343434,FF3B3B3B,FF0B0B0B,FF343434,0,FF343434,FF1C1C1C,FF343434,FF1C1C1C,FF343434,FF242424,FF242424,FF2B2B2B,0,FF343434,FF2B2B2B,0,FF343434,FF242424,FF343434,FF343434,FF343434,FF3B3B3B,FF242424,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF131413,0,FF66C269,FF407C42,FF002E00,FF002E00,FF448545,FF6CCA6E,FF63BB65,FF7BD47D,FF144716,0,FF030B03,0,FF2C642D,0,FF002300,FF6FC271,FF004700,FF4C9E4E,FF5DBB5F,FF57AD59,FF2E6C30,FF4D934F,FF72C473,FF72C473,0,FF0B130B,0,0,FF2B2B2B,FF1C1C1C,0,FF3B3B3B,0,FF242424,FF2B2B2B,0,FF343434,0,FF343434,FF343434,FF242424,FF1C1C1C,FF3B3B3B,0,FF1D2122,FF343434,FF2B2B2B,FF343434,0,0,FF1C1C1C,FF343434,FF242424,FF131413,FF2B2B2B,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0B130B,0,FF6FC271,FF7BD47D,FF005400,FF2E6C30,FF62B464,FF003B00,FF5BAB5C,FF2C812E,FF53AC54,0,0,FF1C1C1C,0,FF72CD74,FF62B464,FF005B00,FF72CD74,FF6CCA6E,FF66C269,FF003400,FF66B968,FF5BB35D,FF4EAB50,FF74D476,FF326C34,0,FF0B130B,0,FF2B2B2B,FF343434,0,FF1C1C1C,FF343434,0,0,FF031303,FF0B130B,FF343434,FF1C1C1C,FF343434,FF343434,FF252B25,FF414241,FF131413,0,0,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,FF3B3B3B,FF131413,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF2C642D,FF439544,FF6FCB72,FF3C833F,FF5FB661,FF3A753B,0,FF5BAB5C,FF5FBA61,FF3C833F,FF407C42,0,0,FF5BB35D,FF53AC54,FF74D476,FF4C9E4E,FF478F49,FF3A753B,0,0,FF003400,FF68BF6A,FF2E6C30,0,FF0C1A0C,0,0,FF3B3B3B,0,0,FF343434,FF201F20,FF030B03,FF131413,0,0,FF2B2B2B,FF343434,FF1B241B,FF302F2F,FF1D001D,0,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF2B2B2B,0,FF343434,FF242424,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF030B03,0,FF002E00,FF449B49,FF63BB65,FF326C34,FF357736,FF63BB65,0,FF61AD62,FF5BAB5C,FF74D476,FF54A456,FF5BAB5C,FF54A456,FF5BB35D,FF002E00,FF61AD62,FF3B7B3D,0,FF448A46,FF63BB65,FF2A752D,FF6CC46D,FF398B3B,0,FF122413,0,0,0,FF343434,FF343434,FF343434,FF343434,0,0,0,FF326C34,FF144716,0,FF122413,0,0,FF448545,FF4B8C4C,FF001900,FF141C14,FF0C1A0C,0,0,FF0B0B0B,0,0,0,0,FF2B2B2B,FF2B2B2B,FF1C1C1C,FF3B3B3B,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0C1A0C,0,FF549D54,FF82DD84,FF439544,0,0,FF62B464,FF448545,0,FF002300,FF63BB65,FF002E00,FF62B464,FF74D476,FF6FCB72,0,0,FF357736,FF66C269,FF5BB35D,FF054B0A,FF549D54,FF6FCB72,FF5FBA61,FF7BD47D,FF003400,0,FF030B03,0,0,FF2B2B2B,FF242424,FF030B03,0,FF326C34,FF72C473,FF82DD84,FF7FD381,0,0,FF3A753B,FF7FD381,FF72CD74,FF88E48A,FF48854A,0,0,FF030B03,FF0B0B0B,FF343434,0,0,0,0,FF0B0B0B,FF343434,FF343434,FF131413,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,FF1A521C,FF4C9E4E,FF6FCB72,FF3A753B,FF0E4811,FF6CC46D,0,FF448545,FF5BAB5C,0,FF5BB35D,FF2A752D,FF1A521C,FF003B00,FF62B464,FF63BB65,FF2C642D,0,0,0,FF449B49,FF72CD74,FF4B8C4C,0,FF0B130B,0,0,0,0,0,FF0B130B,0,FF549D54,FF439544,FF72C473,FF69B36B,0,FF62B464,FF86DC88,FF4B8C4C,FF004700,FF7FD381,FF005400,FF448545,FF4D934F,0,FF1C1C1C,FF343434,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0B0B,FF2B2B2B,FF0B0B0B,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF3E8E40,FF6CCA6E,FF357736,0,FF549D54,FF5BAB5C,FF005B00,FF4C9E4E,FF2A752D,FF66C269,0,FF357736,FF6CC46D,FF478F49,0,0,0,FF48854A,FF63BB65,FF54A456,FF0E4811,0,FF0B130B,0,0,0,0,0,0,0,FF1B241B,0,FF266328,FF7FD381,FF004700,FF78CC7A,FF78CC7A,FF003B00,0,FF235225,FF7FD381,FF78CC7A,FF7BD47D,FF448545,0,FF252B25,FF2B2B2B,FF242424,0,0,0,0,0,0,0,0,FF2B2B2B,FF242424,FF2B2B2B,0,FF0B0B0B,FF343434,FF3B3B3B,FF1C1C1C,0,0,0
DATA 0,0,0,0,0,0,0,0,FF0C1A0C,0,FF4D934F,FF88E48A,FF53AC54,FF61AD62,FF1D471E,0,FF5BAB5C,FF53AC54,FF6CC46D,FF66C269,FF57AD59,FF53AC54,FF6CC46D,FF1A521C,0,FF0C2E0E,FF001900,0,FF54A456,FF74D476,FF54A456,FF235225,0,0,FF181718,FF343434,FF343434,FF2B2B2B,0,0,FF1C1C1C,FF363935,0,FF4B8C4C,FF82DD84,FF7BD47D,FF69B36B,0,0,FF1B241B,0,FF2C642D,FF48854A,0,0,FF242424,FF2B2B2B,FF2B2B2B,FF242424,FF0B0B0B,FF131413,FF120D0D,FF1C1C1C,FF2B2B2B,FF0B0B0B,0,FF2B2B2B,FF343434,FF2B2B2B,FF343434,0,FF2B2B2B,FF343434,0,FF0B0B0B,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,FF0C2E0E,FF003400,FF53AC54,FF74D476,FF398B3B,FF4B8C4C,FF228935,FF66C269,FF6CC46D,0,FF63BB65,FF54A456,0,0,0,FF4D934F,FF78CC7A,FF5BB35D,FF5BB35D,FF63BB65,FF7FD381,FF3B7B3D,0,FF0C1A0C,FF3B3B3B,FF1C1C1C,0,FF343434,FF242424,0,FF2B2B2B,FF2B2B2B,0,FF002300,FF69B36B,FF529454,0,FF131413,FF031303,0,FF030B03,0,0,FF1C1C1C,FF141C14,0,FF2B2B2B,FF242424,0,FF343434,FF343434,FF3B3B3B,FF2B2B2B,FF343434,FF2B2B2B,0,FF3B3B3B,0,FF242424,FF2B2B2B,0,0,FF343434,FF343434,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0C1A0C,0,FF386F39,FF88E48A,FF5DBB5F,FF5BAB5C,FF449B49,FF83AF61,FF6FAC58,FF006A08,FF62B464,FF449B49,FF348237,FF5BAB5C,FF5BAB5C,FF549D54,FF439544,FF6CCA6E,FF398B3B,FF235225,FF144716,0,0,0,FF2B2B2B,FF2B2B2B,0,0,FF343434,FF2B2B2B,0,FF343434,FF1C1C1C,0,FF090408,0,0,FF141C14,FF1B241B,0,FF131413,FF1C1C1C,FF031303,FF2E332C,FF3B3B3B,FF343434,0,FF343434,FF1C1C1C,FF0B0B0B,FF343434,0,FF343434,0,FF242424,FF2B2B2B,FF0B0B0B,FF343434,0,FF343434,FF1C1C1C,FF242424,FF2B2B2B,0,FF343434,FF242424,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,0,FF235225,FF326C34,FF112300,0,FF86002F,FFD35A60,FFC45458,FF5C934D,FF77DA7D,FF46A245,FF88E48A,FF63BB65,FF006C29,FF2D904B,FF399E50,FF6FCB72,FF70BD6F,0,0,FF141C14,FF0B130B,0,FF343434,FF131413,0,FF242424,FF343434,0,0,FF343434,FF1C1C1C,FF0B0B0B,0,FF2E332C,FF2E332C,FF343434,FF343434,0,FF2B2B2B,FF343434,0,FF3B3B3B,FF242424,FF2B2B2B,0,FF343434,0,FF242424,FF343434,0,FF343434,0,FF2B2B2B,FF2B2B2B,0,FF3B3B3B,0,FF343434,FF1C1C1C,FF343434,FF3B3B3B,FF242424,FF343434,FF131413,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,FF030B03,0,0,FF140000,0,FF913C38,FFBE4341,FFD56364,FF8E4632,FF305A21,FF3C833F,FF469951,FF4C803B,FF7C5918,FF8E6F28,FF7C5918,FF3A510B,FF005C28,FF161A0C,FF091204,0,0,FF131413,FF343434,0,0,FF0B0B0B,0,0,FF0F1010,FF343434,FF343434,FF3B3B3B,FF131413,FF343434,FF343434,FF363935,FF2B2B2B,0,FF343434,FF242424,0,FF2B2B2B,FF3B3B3B,FF0B0B0B,FF131413,FF343434,0,FF2B2B2B,FF242424,FF0B0B0B,FF343434,0,FF2B2B2B,FF2B2B2B,FF242424,FF3B3B3B,FF343434,FF343434,FF2B2B2B,FF2B2B2B,FF1C1C1C,FF343434,FF1C1C1C,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF0B130B,FF252B25,FF2A2625,0,FF812929,FFD35A60,FFC45458,FFD56364,FFC45458,0,FF5E4002,FFD4BB62,FFCBB25D,FFC5AD59,FFCBB25D,FFD4BB62,FF967F3B,0,FF161A0C,0,0,FF242424,FF343434,0,0,0,FF0B0B0B,FF131413,FF1C1C1C,FF343434,0,FF2B2B2B,FF2B2B2B,FF343434,0,FF2B2B2B,FF242424,0,FF343434,FF1C1C1C,FF2B2B2B,0,FF242424,FF343434,FF242424,FF343434,0,FF3B3B3B,0,FF1C1C1C,FF343434,0,FF0B0B0B,FF343434,FF343434,FF0B0B0B,FF242424,FF0B0B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,FF242424,FF343434,FF242424,FF002928,FF773B3B,FFD56364,FFC45458,FFCA5252,FFBE4341,FFD35A60,FFC19353,FFAD9941,FF6E5921,0,0,0,FF69541A,FFD4BB62,FFB29B4C,0,FF1B1C11,0,FF2B2B2B,FF2B2B2B,0,0,0,FF1C1C1C,FF343434,FF242424,FF2B2B2B,0,FF343434,FF1C1C1C,FF343434,0,FF2B2B2B,FF242424,FF131413,FF343434,FF242424,FF414241,FF242424,FF343434,FF2B2B2B,FF2B2B2B,FF242424,FF343434,FF242424,0,FF0B0B0B,FF0B0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,0,0,FF001D1C,FF603030,FFBE4341,FFD56364,FF913C38,FF9B3240,FFC17452,FFD7C065,FF452D00,0,FF1B1C11,FF1B1B0D,FF1B1B0D,0,0,FFDAC066,FF8E7937,0,FF130E01,FF2B2B2B,FF2B2B2B,0,FF0B0B0B,0,FF2B2B2B,FF242424,FF2B2B2B,FF242424,0,FF343434,FF2B2B2B,FF343434,0,FF131413,FF343434,FF3B3B3B,FF242424,FF2B2B2B,FF1C1C1C,FF343434,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF0B0B0B,FF343434,0,0,0,FF1A1010,FF002928,FF773B3B,FF8B4242,FF2E332C,0,FFB29B4C,FFAA9349,0,FF292510,0,0,0,FF292510,0,FF766128,FFD4BB62,FF1E0000,0,FF302F2F,FF242424,0,0,0,FF3B3B3B,FF0B0B0B,FF343434,FF131413,0,FF242424,FF3B3B3B,FF1C1C1C,0,0,0,FF1B1C11,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF2B2B2B,FF1C1C1C,0,0,0,0,FF120D0D,FF001D1C,0,FF26241D,FF000019,FFC5AD59,FF8A7433,0,FF151104,0,0,0,0,FF222111,0,FFC5AD59,FF967F3B,0,FF2E332C,FF343434,0,FF0B0B0B,FF343434,FF242424,0,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0F14,0,FF02030A,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF2B2B2B,0,0,0,0,0,0,0,FF140000,FF1B1C11,FF000019,FFC5AD59,FF8E7937,0,FF151104,0,0,0,0,FF191406,0,FF967F3B,FFCBB25D,0,FF1B1B0D,FF302F2F,FF343434,FF343434,FF242424,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF02030A,FF060911,0,FF13150B,0,0,0,0,FF060911,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF1C1C1C,FF242424,0,0,0,0,0,0,0,0,FF26241D,FF000019,FFB49D51,FFAA9349,0,FF1B1B0D,0,0,0,0,0,0,FF3C2300,FFD4BB62,FF5E4002,0,FF130E01,0,0,0,0,0,0,0,0,FF0B0B0B,FF242424,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,FF1C1C1C,0,0,0,0,0,0,FF060911,0,0,FF192335,0,FF6D7EA8,FF1E325B,FF000019,FF16191E,0,FF02030A,0,0,0,0
DATA 0,0,0,0,0,0,0,FF2B2B2B,FF120D0D,0,0,0,0,0,0,0,0,FF26241D,FF000019,FF8A7433,FFCBB25D,0,FF1B1C11,0,0,0,0,0,FF1B1B0D,0,FFAA9349,FFCBB25D,0,FF02030A,FF201E0E,FF130E01,0,0,0,FF0B0B0B,0,FF2B2B2B,FF242424,FF242424,FF2B2B2B,FF1C1C1C,0,FF0B0B0B,0,0,0,0,FF0B0B0B,FF0B0B0B,FF2B2B2B,FF242424,FF242424,FF2B2B2B,FF0B0B0B,FF0B0B0B,0,0,0,0,FF364158,FF00002E,FF617295,FF7E92C3,FF8298D3,FF7287C0,FF8597C3,FF00002E,FF364158,0,0,0,0,0
DATA 0,0,0,0,0,0,FF2B2B2B,FF242424,0,0,0,0,0,0,0,0,0,FF2A2625,FF1D2122,FF1E0000,FFD4BB62,FF6E5921,0,FF191406,0,0,0,0,0,FF0B130B,0,FFC5AD59,FFCBB25D,FF452D00,0,0,FF0D0B03,0,0,FF2B2B2B,FF131413,FF131413,FF343434,FF343434,FF2B2B2B,0,FF2B2B2B,FF131413,0,0,0,0,FF2B2B2B,0,FF1C1C1C,FF343434,FF343434,FF1C1C1C,0,FF2B2B2B,0,0,FF161C29,FF000024,FF4F6294,FF8597C3,0,FF8597C3,FF95ACE5,FF9BADDD,FF334368,FF58668A,FF7E92C3,FF000024,FF29303E,0,0,0
DATA 0,0,0,0,0,FF242424,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF201E0E,0,FFA59149,FFC5AD59,0,FF1B1B0D,0,0,0,0,0,FF0C0400,FF13150B,0,FFAA9349,FFD4B95D,FFB8A255,FF7A6731,0,FF1C1C1C,FF2B2B2B,FF2B2B2B,FF1C1C1C,0,FF1C1C1C,FF2B2B2B,0,0,FF2B2B2B,FF242424,FF242424,0,FF201F1F,FF2B2B2B,FF2B2B2B,FF131413,0,FF242424,FF242424,0,FF131413,FF2B2B2B,FF2B2B2B,FF242424,0,FF7B8CB3,FF7D93CC,FF8A9ED2,FF000019,0,FF8DA2D4,FF4C5D87,0,FF7284B2,FF8298D3,FF8698C9,FF334368,0,FF060911,0
DATA 0,0,0,FF131413,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,0,FF00080A,FF1E0000,FFD4BB62,FF7A6731,0,FF151104,0,0,0,0,FF1B1C11,0,0,FF310000,FFC4A64D,FFF5DE82,FFA89453,0,FF1B1C11,FF242424,FF343434,FF2B2B2B,FF0B0B0B,FF131413,FF2B2B2B,0,FF242424,FF343434,FF2B2B2B,FF131413,0,FF0B0B0B,FF2B2B2B,FF343434,FF2B2B2B,0,FF242424,FF242424,0,FF2B2B2B,FF343434,FF2B2B2B,FF0B0B0B,FF02030A,FF49609C,FF95ACE5,FF9FB4EB,FF7284B2,FF00002E,FF8DA2D4,FF364B7E,FF45567C,FF90A5DF,FF9FB4EB,FF6D83C1,FF031C43,0,FF02030A,0
DATA 0,0,FF242424,FF3B3B3B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF0B0B0B,0,FF201E0E,0,FF9C8644,FFC5AD59,0,FF1B1C11,0,FF151104,FF191406,FF030B03,0,FF5E4B17,FFB49D51,FFDAC066,FFB8A255,FF5E4002,0,FF0D0B03,FF1C1C1C,FF2B2B2B,FF131413,FF1C1C1C,FF2B2B2B,FF242424,FF2B2B2B,FF2B2B2B,FF242424,FF0B0B0B,FF242424,FF242424,0,FF242424,FF242424,FF0B0B0B,FF242424,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF242424,FF0B0B0B,FF272829,FF1B1B0D,FF031C43,FF7D8FB8,FF6D7EA8,FF26417D,FF8597C3,FF7F95D0,FF8298D3,FF7F95D0,FF93A5D3,FF4F6294,FF485D93,FF8597C3,FF45567C,0,FF0B0F14,0
DATA 0,0,0,FF131413,FF242424,FF2B2B2B,FF2B2B2B,FF131413,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2B,0,0,FF0D0B03,0,FF5E4B17,FFD4BB62,FF301400,0,FF222111,0,0,0,FFB8A255,FFDAC066,FFB29B4C,FF59430D,0,0,FF13150B,0,0,0,0,0,FF1C1C1C,FF2B2B2B,FF242424,FF2B2B2B,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,FF2B2B2B,FF242424,0,0,0,0,FF0D182D,FF1E325B,FF000019,0,FF000050,FF90A5DF,FF5F7FCC,FF90A5DF,FF49609C,0,0,FF001F52,FF1B2A47,0,0,0
DATA 0,0,0,0,0,0,FF242424,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,FF242424,FF1C1C1C,0,0,0,0,FF3C2300,FFD0B760,FF5E4B17,0,0,FF665422,FF7A6731,0,FFCEB563,FFB29B4C,0,0,FF201E0E,FF130E01,0,0,FF1C1C1C,FF2B2B2B,FF242424,FF2B2B2B,FF2B2B2B,FF242424,FF2B2B2B,FF242424,FF343434,FF242424,FF2B2B2B,FF272829,0,FF242424,FF2B2B2B,FF242424,FF2B2B2B,FF242424,FF242424,FF242424,FF242424,FF2B2B2B,FF242424,FF2E2F31,FF1B1B0D,FF1B2A47,FF8597C3,FF8A9ED2,FF7287C0,FF9BADDD,FF657AB4,FF8298D3,FF657AB4,FF93A5D3,FF8597C3,FF7D93CC,FF93A5D3,FF4C5D87,0,FF0F1219,0
DATA 0,0,0,0,0,0,0,FF131413,FF2B2B2B,0,0,FF2B2B2B,FF131413,0,0,FF2B2B2B,FF1C1C1C,0,0,0,0,FF452D00,FFD4BB62,FF330A00,FF330A00,FFB49D51,FFDAC066,FFE6CD73,FF8E6F28,FFCBB25D,FFA59149,0,FF292510,0,0,0,0,0,FF242424,FF343434,FF242424,0,FF131413,FF2B2B2B,0,FF131413,FF343434,FF2B2B2B,FF131413,0,0,FF2B2B2B,FF343434,FF1C1C1C,0,FF242424,FF242424,0,FF242424,FF343434,FF2B2B2B,FF131413,0,FF485D93,FF95ACE5,FF9BAEE4,FF364B7E,0,FF8A9ED2,FF334368,0,FF8298D3,FF9FB4EB,FF6D82BD,FF00002E,FF0D0B03,0,0
DATA 0,0,0,0,0,0,0,FF131413,FF2B2B2B,0,FF2B2B2B,FF343434,FF2B2B2B,FF2B2B2B,0,FF242424,FF1C1C1C,0,0,FF130E01,0,FF69541A,FFD4B95D,FFB19342,FFD6BF68,FFB8A255,FF513100,FF8A7433,FFD4BB62,FFB49D51,FF1E0000,0,0,0,0,0,0,FF131413,FF242424,FF242424,FF1C1C1C,0,FF1C1C1C,FF2B2B2B,0,0,FF2B2B2B,FF1C1C1C,FF242424,0,FF242424,FF1C1C1C,FF2B2B2B,FF131413,0,FF2B2B2B,FF242424,0,FF131413,FF2B2B2B,FF201F20,FF26241D,0,FF7182A6,FF657AB4,FF8A9ED2,0,FF000050,FF90A5DF,FF4F6294,0,FF7284B2,FF798EC9,FF7284B2,FF3D4964,0,FF060911,0
DATA 0,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2B,FF242424,0,0,FF242424,FF2B2B2B,FF343434,FF2B2B2B,0,0,FF201E0E,0,FF9C8644,FFF5DE82,FFC4A64D,FF665422,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF242424,0,FF1C1C1C,FF343434,FF343434,FF2B2B2B,0,FF242424,FF0B0B0B,0,0,0,0,FF242424,0,FF242424,FF343434,FF343434,FF242424,0,FF242424,0,0,FF16191E,0,FF45567C,FF6A7A9E,FF000F44,FF93A5D3,FF95ACE5,FF9BAEE4,FF58668A,FF334368,FF6D7EA8,0,FF0D0B03,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,0,0,FF0D0B03,0,FF665422,FF766128,0,0,FF222111,FF0C0400,FF191406,FF161A0C,FF1B1B0D,0,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF1C1C1C,FF242424,FF242424,FF1C1C1C,0,0,0,0,0,0,0,FF131413,FF242424,FF242424,FF242424,FF242424,FF0B0B0B,0,0,0,0,FF1C1C1C,FF0B0F14,0,FF6A7A9E,FF657AB4,FF7D93CC,FF657AB4,FF7B8CB3,0,0,FF1D2122,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0D0B03,0,0,FF1B1B0D,FF151104,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0B0B,FF1C1C1C,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,FF131413,0,0,0,0,0,0,0,FF02030A,FF16191E,0,0,FF617295,FF142747,0,FF16191E,FF0B0B0B,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF151104,FF191406,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF131413,0,0,FF131413,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0F1219,FF02030A,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
frame4:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF141414,0,0,0,FF3B3B3B,FF333333,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF141414,FF0B0B0B,0,FF242424,FF2B2B2B,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0C1A0C,FF0B130B,0,0,0,FF0C1A0C,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF3B3B3B,FF1C1C1C,0,FF141414,FF424242,FF242424,0,0,0,0,0,0,0,0,0,0,FF141414,FF1C1C1C,FF1C1C1C,FF242424,0,FF333333,FF1C1C1C,0,FF3B3B3B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF090408,FF0C1A0C,FF0B0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0C1A0C,0,0,0,0,0,0,0,0,0,0,0,0,0,FF424242,FF2B2B2B,0,FF2B2B2B,FF3B3B3B,FF1C1C1C,0,0,FF0B0B0B,0,0,FF242424,FF1C1C1C,FF333333,FF141414,0,FF2B2B2B,FF3B3B3B,FF3B3B3B,FF242424,0,FF3B3B3B,0,FF1C1C1C,FF3B3B3B,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF002300,FF407C42,FF326C34,0,0,0,FF448A46,FF143C15,0,FF0C1A0C,0,0,0,0,0,0,0,0,0,FF030B03,0,0,0,0,0,FF030B03,0,0,0,0,0,0,0,FF141414,FF3B3B3B,FF2B2B2B,FF0B0B0B,FF333333,FF333333,FF1C1C1C,0,FF2B2B2B,FF3B3B3B,FF2B2B2B,0,FF3B3B3B,FF3B3B3B,FF3B3B3B,0,0,FF333333,FF1C1C1C,FF333333,FF141414,FF141414,FF3B3B3B,0,FF2B2B2B,FF333333,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0B0B0B,0,FF76CB78,FF6FCB72,FF5FB661,FF3B7B3D,FF4A9C4C,FF81E183,FF2C662E,0,0,0,0,0,0,FF031303,0,0,FF0B130B,FF030B03,FF030B03,FF4F9351,FF143C15,0,FF112111,FF141414,0,0,0,0,0,0,0,0,FF242424,FF333333,FF2B2B2B,FF333333,FF2B2B2B,FF333333,FF0B0B0B,FF1C1C1C,FF333333,FF1C1C1C,FF333333,FF1C1C1C,FF333333,FF1C1C1C,FF333333,0,FF141414,FF333333,0,FF333333,0,FF242424,FF3B3B3B,0,FF3B3B3B,FF242424,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF031303,0,FF266328,FF5BB35D,FF186C1C,FF63BB65,FF56A658,FF53AB55,FF347936,FF002E00,FF61AC62,FF08350A,0,FF030B03,0,0,0,FF0C1A0C,0,0,FF1D5B20,FF87E589,FF347535,0,0,0,FF003B00,FF0C1A0C,0,0,0,0,0,0,FF333333,FF242424,FF333333,FF3B3B3B,FF0B0B0B,FF333333,0,FF333333,FF1C1C1C,FF333333,FF1C1C1C,FF333333,FF242424,FF242424,FF2B2B2B,0,FF333333,FF2B2B2B,0,FF333333,FF242424,FF333333,FF333333,FF333333,FF3B3B3B,FF242424,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF141414,0,FF66C269,FF407C42,FF002E00,FF002E00,FF448545,FF6CCA6E,FF63BB65,FF7CD37E,FF144A16,0,FF030B03,0,FF2C662E,0,FF002300,FF6FC271,FF004900,FF4FA051,FF5DBB5F,FF57AD59,FF2E6C30,FF4B944C,FF72C473,FF72C473,0,FF0B130B,0,0,FF2B2B2B,FF1C1C1C,0,FF3B3B3B,0,FF242424,FF2B2B2B,0,FF333333,0,FF333333,FF333333,FF242424,FF1C1C1C,FF3B3B3B,0,FF1D2122,FF333333,FF2B2B2B,FF333333,0,0,FF1C1C1C,FF333333,FF242424,FF141414,FF2B2B2B,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0B130B,0,FF6FC271,FF79DA7B,FF005400,FF2E6C30,FF62B464,FF003B00,FF5BAB5C,FF2C812E,FF53AB55,0,0,FF1C1C1C,0,FF72CD74,FF62B464,FF005B00,FF72CD74,FF6CCA6E,FF66C269,FF003400,FF66B968,FF5BB35D,FF4EAB50,FF76D578,FF326C34,0,FF0B130B,0,FF2B2B2B,FF333333,0,FF1C1C1C,FF333333,0,0,FF031303,FF0B130B,FF333333,FF1C1C1C,FF333333,FF333333,FF252B25,FF3D433E,FF141414,0,0,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,FF3B3B3B,FF141414,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF2A5E2C,FF439544,FF6FCB72,FF3C833F,FF5FB661,FF3A753B,0,FF5BAB5C,FF5FBA61,FF3C833F,FF407C42,0,0,FF5BB35D,FF53AB55,FF73D375,FF4A9C4C,FF478F49,FF3A753B,0,0,FF003400,FF68BF6A,FF2E6C30,0,FF0C1A0C,0,0,FF3B3B3B,0,0,FF333333,FF201F20,FF030B03,FF141414,0,0,FF2B2B2B,FF333333,FF1B231C,FF302F2F,FF1D001D,0,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF2B2B2B,0,FF333333,FF242424,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF030B03,0,FF002E00,FF459C4A,FF63BB65,FF326C34,FF347535,FF63BB65,0,FF61AC62,FF5BAB5C,FF73D375,FF53A455,FF5BAB5C,FF53A455,FF5BB35D,FF002E00,FF61AC62,FF3B7B3D,0,FF448A46,FF63BB65,FF2A792D,FF6CC46D,FF378839,0,FF162A16,0,0,0,FF333333,FF333333,FF333333,FF333333,0,0,0,FF326C34,FF144A16,0,FF112111,0,0,FF448545,FF4B8C4B,FF001900,FF141C14,FF0C1A0C,0,0,FF0B0B0B,0,0,0,0,FF2B2B2B,FF2B2B2B,FF1C1C1C,FF3B3B3B,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF0C1A0C,0,FF569E58,FF81E183,FF439544,0,0,FF62B464,FF448545,0,FF002300,FF63BB65,FF002E00,FF62B464,FF73D375,FF6FCB72,0,0,FF347936,FF66C269,FF5BB35D,FF054B0A,FF539D54,FF6FCB72,FF5FBA61,FF7CD37E,FF003400,0,FF030B03,0,0,FF2B2B2B,FF242424,FF030B03,0,FF326C34,FF72C473,FF84DA85,FF7FD281,0,0,FF3A753B,FF7FD281,FF72CD74,FF89E38B,FF48854A,0,0,FF030B03,FF0B0B0B,FF333333,0,0,0,0,FF0B0B0B,FF333333,FF333333,FF141414,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,FF1C531E,FF4FA051,FF6FCB72,FF3A753B,FF0E4B11,FF6CC46D,0,FF448545,FF5BAB5C,0,FF5BB35D,FF2B742D,FF1C531E,FF003B00,FF62B464,FF63BB65,FF2C662E,0,0,0,FF439845,FF72CD74,FF4B8C4B,0,FF0B130B,0,0,0,0,0,FF0B130B,0,FF539D54,FF439544,FF72C473,FF68AF6A,0,FF62B464,FF86DC88,FF4B8C4B,FF004600,FF7FD281,FF005400,FF448545,FF4F9351,0,FF1C1C1C,FF333333,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0B0B,FF2B2B2B,FF0B0B0B,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF3E8E40,FF6CCA6E,FF367638,0,FF539D54,FF5BAB5C,FF005B00,FF4CA04E,FF2B742D,FF66C269,0,FF367638,FF6CC46D,FF478F49,0,0,0,FF48854A,FF63BB65,FF53A455,FF0D4510,0,FF0B130B,0,0,0,0,0,0,0,FF1B231C,0,FF266328,FF7FD281,FF004600,FF79CD7B,FF79CD7B,FF003B00,0,FF235325,FF83D785,FF79CD7B,FF7CD37E,FF448545,0,FF252B25,FF2B2B2B,FF242424,0,0,0,0,0,0,0,0,FF2B2B2B,FF242424,FF2B2B2B,0,FF0B0B0B,FF333333,FF3B3B3B,FF1C1C1C,0,0,0
DATA 0,0,0,0,0,0,0,0,FF0C1A0C,0,FF4F9351,FF87E589,FF52B053,FF5EAE60,FF1D471E,0,FF5BAB5C,FF53AB55,FF6CC46D,FF64C066,FF57AD59,FF53AB55,FF6CC46D,FF184F1A,0,FF0C2E0E,FF001900,0,FF53A455,FF73D375,FF56A658,FF235325,0,0,FF181718,FF333333,FF333333,FF2B2B2B,0,0,FF1C1C1C,FF363935,0,FF4F8D50,FF84DA85,FF7CD37E,FF6AB56C,0,0,FF182818,0,FF2C662E,FF48854A,0,0,FF242424,FF2B2B2B,FF2B2B2B,FF242424,FF0B0B0B,FF141414,FF120D0D,FF1C1C1C,FF2B2B2B,FF0B0B0B,0,FF2B2B2B,FF333333,FF2B2B2B,FF333333,0,FF2B2B2B,FF333333,0,FF0B0B0B,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,FF0C2E0E,FF003400,FF53AB55,FF76D578,FF3A8C3C,FF4B8C4B,FF228935,FF66C269,FF6CC46D,0,FF63BB65,FF53A455,0,0,0,FF4B944C,FF79CD7B,FF5BB35D,FF5BB35D,FF63BB65,FF7FD281,FF3B7B3D,0,FF0C1A0C,FF3B3B3B,FF1C1C1C,0,FF333333,FF242424,0,FF2B2B2B,FF2B2B2B,0,FF002300,FF6AB56C,FF529454,0,FF141414,FF031303,0,FF030B03,0,0,FF1C1C1C,FF141C14,0,FF2B2B2B,FF242424,0,FF333333,FF333333,FF3B3B3B,FF2B2B2B,FF333333,FF2B2B2B,0,FF3B3B3B,0,FF242424,FF2B2B2B,0,0,FF333333,FF333333,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF0C1A0C,0,FF386F39,FF89E38B,FF5DBB5F,FF5BAB5C,FF459C4A,FF83AF61,FF6FAC58,FF006A08,FF62B464,FF459C4A,FF348237,FF5BAB5C,FF5BAB5C,FF539D54,FF439544,FF6CCA6E,FF3A8C3C,FF235325,FF164317,0,0,0,FF2B2B2B,FF2B2B2B,0,0,FF333333,FF2B2B2B,0,FF333333,FF1C1C1C,0,FF090408,0,0,FF141C14,FF1B231C,0,FF141414,FF1C1C1C,FF031303,FF2D332D,FF3B3B3B,FF333333,0,FF333333,FF1C1C1C,FF0B0B0B,FF333333,0,FF333333,0,FF242424,FF2B2B2B,FF0B0B0B,FF333333,0,FF333333,FF1C1C1C,FF242424,FF2B2B2B,0,FF333333,FF242424,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF030B03,0,FF244F25,FF326C34,FF112300,0,FF86002F,FFD55B63,FFC34F56,FF5C934D,FF77DA7D,FF46A245,FF89E38B,FF63BB65,FF006C29,FF2D904B,FF399E50,FF6FCB72,FF70BD6F,0,0,FF141C14,FF0B130B,0,FF333333,FF141414,0,FF242424,FF333333,0,0,FF333333,FF1C1C1C,FF0B0B0B,0,FF2D332D,FF2D332D,FF333333,FF333333,0,FF2B2B2B,FF333333,0,FF3B3B3B,FF242424,FF2B2B2B,0,FF333333,0,FF242424,FF333333,0,FF333333,0,FF2B2B2B,FF2B2B2B,0,FF3B3B3B,0,FF333333,FF1C1C1C,FF333333,FF3B3B3B,FF242424,FF333333,FF141414,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,FF030B03,0,0,FF140000,0,FF913E3A,FFBE4743,FFD56364,FF8E4632,FF305A21,FF3C833F,FF469951,FF4C803B,FF7D5518,FF8C6D2B,FF7A5C17,FF3A510B,FF005C28,FF161A0C,FF091204,0,0,FF141414,FF333333,0,0,FF0B0B0B,0,0,FF0F1010,FF333333,FF333333,FF3B3B3B,FF141414,FF333333,FF333333,FF363935,FF2B2B2B,0,FF333333,FF242424,0,FF2B2B2B,FF3B3B3B,FF0B0B0B,FF141414,FF333333,0,FF2B2B2B,FF242424,FF0B0B0B,FF333333,0,FF2B2B2B,FF2B2B2B,FF242424,FF3B3B3B,FF333333,FF333333,FF2B2B2B,FF2B2B2B,FF1C1C1C,FF333333,FF1C1C1C,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,FF0B130B,FF252B25,FF2A2625,0,FF812929,FFD15A5A,FFC35555,FFD56364,FFC5575A,0,FF613B00,FFD4BB62,FFCBB35D,FFC4AC56,FFCBB35D,FFD4BB62,FF9B7F39,0,FF161A0C,0,0,FF242424,FF333333,0,0,0,FF0B0B0B,FF141414,FF1C1C1C,FF333333,0,FF2B2B2B,FF2B2B2B,FF333333,0,FF2B2B2B,FF242424,0,FF333333,FF1C1C1C,FF2B2B2B,0,FF242424,FF333333,FF242424,FF333333,0,FF3B3B3B,0,FF1C1C1C,FF333333,0,FF0B0B0B,FF333333,FF333333,FF0B0B0B,FF242424,FF0B0B0B,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,FF242424,FF333333,FF242424,FF002928,FF773B3B,FFD56364,FFC5575A,FFCA5252,FFBE4743,FFD55B63,FFC19353,FFAD9941,FF6E5921,0,0,0,FF685217,FFD4BB62,FFB29B4C,0,FF1B1C11,0,FF2B2B2B,FF2B2B2B,0,0,0,FF1C1C1C,FF333333,FF242424,FF2B2B2B,0,FF333333,FF1C1C1C,FF333333,0,FF2B2B2B,FF242424,FF141414,FF333333,FF242424,FF424242,FF242424,FF333333,FF2B2B2B,FF2B2B2B,FF242424,FF333333,FF242424,0,FF0B0B0B,FF0B0B0B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,0,0,FF001D1C,FF603030,FFBD3D3D,FFD56364,FF903935,FF9B3240,FFC17452,FFD7C065,FF452D00,0,FF1B1C11,FF1B1B0D,FF1B1B0D,0,0,FFDAC066,FF8E7937,0,FF130E01,FF2B2B2B,FF2B2B2B,0,FF0B0B0B,0,FF2B2B2B,FF242424,FF2B2B2B,FF242424,0,FF333333,FF2B2B2B,FF333333,0,FF141414,FF333333,FF3B3B3B,FF242424,FF2B2B2B,FF1C1C1C,FF333333,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF0B0B0B,FF333333,0,0,0,FF1A1010,FF002928,FF773B3B,FF8B4242,FF2A3027,0,FFB29B4C,FFAA9349,0,FF292510,0,0,0,FF292510,0,FF776125,FFD4BB62,FF1D0000,0,FF302F2F,FF242424,0,0,0,FF3B3B3B,FF0B0B0B,FF333333,FF141414,0,FF242424,FF3B3B3B,FF1C1C1C,0,0,0,FF1B1C11,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF2B2B2B,FF1C1C1C,0,0,0,0,FF120D0D,FF001D1C,0,FF26241C,FF00001C,FFC5AD59,FF8A7433,0,FF151104,0,0,0,0,FF1F2012,0,FFC5AD59,FF96813E,0,FF34332C,FF333333,0,FF0B0B0B,FF333333,FF242424,0,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,FF2B2B2B,0,0,0,0,0,0,0,FF140000,FF1B1C11,FF00001C,FFC5AD59,FF8E7937,0,FF151104,0,0,0,0,FF191406,0,FF917C3A,FFC8AF5D,0,FF1B1B0D,FF302F2F,FF333333,FF333333,FF242424,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF1C1C1C,FF242424,0,0,0,0,0,0,0,0,FF26241C,FF000014,FFB49D51,FFAA9349,0,FF1B1B0D,0,0,0,0,0,0,FF3C2300,FFD4BB62,FF5D4304,0,FF130E01,0,0,0,0,0,0,0,0,FF0B0B0B,FF242424,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,FF1C1C1C,0,0,0,0,0,0,0,0,0,0,0,FF242424,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,FF2B2B2B,FF120D0D,0,0,0,0,0,0,0,0,FF29271E,FF00001C,FF8A7433,FFCBB35D,0,FF1B1C11,0,0,0,0,0,FF1B1B0D,0,FFAA9349,FFCBB35D,0,FF000008,FF201E0E,FF130E01,0,0,0,FF0B0B0B,0,FF2B2B2B,FF242424,FF242424,FF2B2B2B,FF1C1C1C,0,FF0B0B0B,0,0,0,0,FF0B0B0B,FF0B0B0B,FF2B2B2B,FF242424,FF242424,FF2B2B2B,FF0B0B0B,FF0B0B0B,0,0,0,0,FF0B0B0B,0,FF1C1C1C,FF242424,FF2B2B2B,FF242424,FF2B2B2B,0,FF0B0B0B,0,0,0,0,0
DATA 0,0,0,0,0,0,FF2B2B2B,FF242424,0,0,0,0,0,0,0,0,0,FF2A2625,FF1D2122,FF230000,FFD4BB62,FF6E5921,0,FF191406,0,0,0,0,0,FF0B130B,0,FFC5AD59,FFCBB35D,FF452D00,0,0,FF0D0B03,0,0,FF2B2B2B,FF141414,FF141414,FF333333,FF333333,FF2B2B2B,0,FF2B2B2B,FF141414,0,0,0,0,FF2B2B2B,0,FF1C1C1C,FF333333,FF333333,FF1C1C1C,0,FF2B2B2B,0,0,0,0,FF141414,FF2B2B2B,0,FF2B2B2B,FF333333,FF333333,FF0B0B0B,FF1C1C1C,FF2B2B2B,0,FF0B0B0B,0,0,0
DATA 0,0,0,0,0,FF242424,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF201E0E,0,FFA59149,FFC5AD59,0,FF1B1B0D,0,0,0,0,0,FF0C0400,FF12150A,0,FFAA9349,FFD1B75F,FFBAA354,FF786734,0,FF1C1C1C,FF2B2B2B,FF2B2B2B,FF1C1C1C,0,FF1C1C1C,FF2B2B2B,0,0,FF2B2B2B,FF242424,FF242424,0,FF201F1F,FF2B2B2B,FF2B2B2B,FF141414,0,FF242424,FF242424,0,FF141414,FF2B2B2B,FF2B2B2B,FF1C1C1C,0,FF2B2B2B,FF242424,FF2B2B2B,0,0,FF2B2B2B,FF141414,0,FF242424,FF2B2B2B,FF2B2B2B,FF141414,0,0,0
DATA 0,0,0,FF141414,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,0,FF00080A,FF1D0000,FFD4BB62,FF7D682C,0,FF151104,0,0,0,0,FF1B1C11,0,0,FF310000,FFC7A647,FFF5DE82,FFA89453,0,FF1B1C11,FF242424,FF333333,FF2B2B2B,FF0B0B0B,FF141414,FF2B2B2B,0,FF242424,FF333333,FF2B2B2B,FF141414,0,FF0B0B0B,FF2B2B2B,FF333333,FF2B2B2B,0,FF242424,FF242424,0,FF2B2B2B,FF333333,FF2B2B2B,FF0B0B0B,0,FF141414,FF333333,FF333333,FF242424,0,FF2B2B2B,FF0B0B0B,FF141414,FF333333,FF333333,FF242424,0,0,0,0
DATA 0,0,FF242424,FF3B3B3B,FF2B2B2B,0,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF0B0B0B,0,FF201E0E,0,FF9C8644,FFC5AD59,0,FF1B1C11,0,FF151104,FF191406,FF030B03,0,FF604B16,FFB49D51,FFDAC066,FFBAA354,FF5D4304,0,FF0D0B03,FF1C1C1C,FF2B2B2B,FF141414,FF1C1C1C,FF2B2B2B,FF242424,FF2B2B2B,FF2B2B2B,FF242424,FF0B0B0B,FF242424,FF242424,0,FF242424,FF242424,FF0B0B0B,FF242424,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF242424,FF0B0B0B,FF242424,FF242424,0,FF2B2B2B,FF242424,FF0B0B0B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF141414,FF141414,FF2B2B2B,FF141414,0,0,0
DATA 0,0,0,FF141414,FF242424,FF2B2B2B,FF2B2B2B,FF141414,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2B,0,0,FF0D0B03,0,FF604B16,FFD4BB62,FF301400,0,FF242211,0,0,0,FFB4A058,FFDAC066,FFB29B4C,FF59430D,0,0,FF12150A,0,0,0,0,0,FF1C1C1C,FF2B2B2B,FF242424,FF2B2B2B,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,FF2B2B2B,FF242424,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF242424,FF2B2B2B,FF141414,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,FF242424,FF2B2B2B,FF2B2B2B,0,0,0,0,0,0,FF242424,FF1C1C1C,0,0,0,0,FF3C2300,FFD1B75F,FF5B4A19,0,0,FF655423,FF786734,0,FFCEB563,FFB29B4C,0,0,FF201E0E,FF130E01,0,0,FF1C1C1C,FF2B2B2B,FF242424,FF2B2B2B,FF2B2B2B,FF242424,FF2B2B2B,FF242424,FF333333,FF242424,FF2B2B2B,FF272728,0,FF242424,FF2B2B2B,FF242424,FF2B2B2B,FF242424,FF242424,FF242424,FF242424,FF2B2B2B,FF242424,FF2B2B2B,FF242424,0,FF2B2B2B,FF2B2B2B,FF242424,FF333333,FF1C1C1C,FF2B2B2B,FF1C1C1C,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF2B2B2B,FF1C1C1C,0,0,0
DATA 0,0,0,0,0,0,0,FF141414,FF2B2B2B,0,0,FF2B2B2B,FF141414,0,0,FF2B2B2B,FF1C1C1C,0,0,0,0,FF452D00,FFD4BB62,FF370800,FF2F0C00,FFB49D51,FFDAC066,FFE6CD73,FF907125,FFCBB35D,FFA59149,0,FF292510,0,0,0,0,0,FF242424,FF333333,FF242424,0,FF141414,FF2B2B2B,0,FF141414,FF333333,FF2B2B2B,FF141414,0,0,FF2B2B2B,FF333333,FF1C1C1C,0,FF242424,FF242424,0,FF242424,FF333333,FF2B2B2B,0,0,FF141414,FF333333,FF333333,FF0B0B0B,0,FF2B2B2B,FF0B0B0B,0,FF2B2B2B,FF333333,FF242424,0,0,0,0
DATA 0,0,0,0,0,0,0,FF141414,FF2B2B2B,0,FF2B2B2B,FF333333,FF2B2B2B,FF2B2B2B,0,FF242424,FF1C1C1C,0,0,FF130E01,0,FF6A551D,FFD6BA5B,FFB19342,FFD6BF68,FFBAA354,FF513100,FF8A7433,FFD4BB62,FFB49D51,FF1D0000,0,0,0,0,0,0,FF141414,FF242424,FF242424,FF1C1C1C,0,FF1C1C1C,FF2B2B2B,0,0,FF2B2B2B,FF1C1C1C,FF242424,0,FF242424,FF1C1C1C,FF2B2B2B,FF141414,0,FF2B2B2B,FF242424,0,FF141414,FF2B2B2B,FF1C1C1C,FF1C1C1C,0,FF242424,FF1C1C1C,FF2B2B2B,0,0,FF333333,FF141414,0,FF242424,FF242424,FF242424,FF141414,0,0,0
DATA 0,0,0,0,0,0,0,0,FF1C1C1C,FF2B2B2B,FF242424,0,0,FF242424,FF2B2B2B,FF333333,FF2B2B2B,0,0,FF201E0E,0,FF9C8644,FFF5DE82,FFC0A652,FF695522,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF242424,0,FF1C1C1C,FF333333,FF333333,FF2B2B2B,0,FF242424,FF0B0B0B,0,0,0,0,FF242424,0,FF242424,FF333333,FF333333,FF242424,0,FF242424,0,0,0,0,FF141414,FF242424,0,FF2B2B2B,FF333333,FF333333,FF141414,FF0B0B0B,FF242424,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF242424,FF2B2B2B,0,0,FF0D0B03,0,FF655423,FF75612B,0,0,FF242211,FF0C0400,FF191406,FF161A0C,FF1B1B0D,0,0,0,0,0,0,0,0,0,0,0,FF2B2B2B,FF1C1C1C,FF242424,FF242424,FF1C1C1C,0,0,0,0,0,0,0,FF141414,FF242424,FF242424,FF242424,FF242424,FF0B0B0B,0,0,0,0,0,0,0,FF242424,FF1C1C1C,FF2B2B2B,FF1C1C1C,FF242424,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0D0B03,0,0,FF1B1B0D,FF151104,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF0B0B0B,FF1C1C1C,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,FF141414,0,0,0,0,0,0,0,0,0,0,0,FF1C1C1C,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,FF151104,FF191406,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 
SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  R = radius
    '  C = fill color
    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
 

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 23, 2020, 12:08:59 pm

@SMcNeill Fireworks never get old, nice colorful version.

@FellippeHeitor nice, no monster data load program :)

This has been a crummy year and I hear allot of people saying it's hard to get into the spirit, gotta say this thread sure helped distract me :)

Title: Re: %uD83C%uDF84%uD83C%uDF81%u2728 Holiday Season - are you ready to code?
Post by: Ashish on December 23, 2020, 01:25:35 pm

Ashish's Submission -

Code: [Select]

'coded for holidays 2020
'Merry Christmas! & Happy Holidays!
'from Ashish
RANDOMIZE TIMER
_TITLE "Merry Christmas 2020! Greetings From Ashish!"
SCREEN _NEWIMAGE(800, 600, 32)


TYPE vec3
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
END TYPE

TYPE snow_obj
    pos AS vec3
    vel AS vec3
END TYPE

DECLARE LIBRARY 'camera control function
    SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
END DECLARE

DIM SHARED perlin_octaves, perlin_amp_falloff 'noise related variables
DIM SHARED max_w, max_h
max_w = 100: max_h = 100

DIM SHARED gl_init

DIM SHARED snow(1000) AS snow_obj

FOR i = 0 TO UBOUND(snow)
    snow(i).pos.y = p5random(10, 20)
    IF RND > 0.5 THEN snow(i).pos.x = p5random(-20, -2) ELSE snow(i).pos.x = p5random(2, 20)
    IF RND > 0.5 THEN snow(i).pos.z = p5random(-20, -2) ELSE snow(i).pos.z = p5random(2, 20)

    snow(i).vel.y = p5random(-0.3, -0.05)
NEXT

DIM SHARED map_vert(max_w * max_h * 6), map_norm(max_w * max_h * 6), h_map(100, 100) AS vec3
DIM SHARED max_vert_index

REDIM SHARED pineMesh(0) AS SINGLE, pineMeshInfo(0) AS mesh_part_info, pineMeshFileInfo AS MDL_INFO
f$ = Writetree.basData("tree.binobj")
objImportBin f$, pineMesh(), pineMeshInfo(), pineMeshFileInfo


DIM SHARED sky_tex AS LONG
sky_tex = _NEWIMAGE(800, 600, 32)
_DEST sky_tex
FOR i = 0 TO 300
    LINE (0, i)-(800, i), _RGB(map(i, 0, 300, 46, 130), map(i, 0, 300, 0, 2), map(i, 0, 300, 91, 130))
NEXT
FOR i = 300 TO 600
    LINE (0, i)-(800, i), _RGB(map(i, 300, 600, 130, 237), map(i, 300, 600, 2, 173), map(i, 300, 600, 130, 90))
NEXT
_DEST 0


FOR i = 0 TO 100
    FOR j = 0 TO 100
        ' pset (i,j),_rgb32(150*abs(noise(i*0.05,j*0.05,0))+50)

        h_map(i, j).x = map(i, 0, 100, -30, 30)
        h_map(i, j).y = -2 + 8 * ABS(noise(i * 0.05, j * 0.05, 0))
        h_map(i, j).z = map(j, 0, 100, -30, 30)
    NEXT j
NEXT i

init_land

_PUTIMAGE , sky_tex
_GLRENDER _ONTOP
gl_init = 1
DO
    FOR i = 0 TO UBOUND(snow)
        snow(i).pos.y = snow(i).pos.y + snow(i).vel.y
        IF snow(i).pos.y < -2 THEN
            snow(i).pos.y = p5random(10, 20)
            IF RND > 0.5 THEN snow(i).pos.x = p5random(-20, -2) ELSE snow(i).pos.x = p5random(2, 20)
            IF RND > 0.5 THEN snow(i).pos.z = p5random(-20, -2) ELSE snow(i).pos.z = p5random(2, 20)

            snow(i).vel.y = p5random(-0.3, -0.05)
        END IF
    NEXT
    _LIMIT 60
LOOP

SUB _GL ()
    STATIC init, clock
    IF gl_init = 0 THEN EXIT SUB
    IF init = 0 THEN
        init = 1
        _glViewport 0, 0, 800, 600

    END IF


    _glEnable _GL_DEPTH_TEST
    _glEnable _GL_LIGHTING
    _glEnable _GL_LIGHT0

    _glShadeModel _GL_SMOOTH

    'bluish light
    _glLightfv _GL_LIGHT0, _GL_AMBIENT, glVec4(0.05, 0.05, 0.1, 0)
    _glLightfv _GL_LIGHT0, _GL_DIFFUSE, glVec4(0.95, 0.95, 1, 0)
    _glLightfv _GL_LIGHT0, _GL_SPECULAR, glVec4(0.6, 0.6, 0.6, 0) ' glVec4(0.75, 0.80, 0.85, 0)


    _glMatrixMode _GL_PROJECTION
    _glLoadIdentity
    _gluPerspective 60, 1.3333, 0.1, 50


    _glMatrixMode _GL_MODELVIEW
    _glLoadIdentity
    gluLookAt 8, 10, 8, 0, 5, 0, 0, 1, 0
    _glRotatef clock, 0, 1, 0

    'land
    _glColor3f 1, 1, 1
    _glEnable _GL_COLOR_MATERIAL
    _glEnableClientState _GL_VERTEX_ARRAY
    _glVertexPointer 3, _GL_FLOAT, 0, _OFFSET(map_vert())
    _glEnableClientState _GL_NORMAL_ARRAY
    _glNormalPointer _GL_FLOAT, 0, _OFFSET(map_norm())

    _glDrawArrays _GL_TRIANGLE_STRIP, 1, (max_vert_index / 3) - 1
    'tree
    _glDisable _GL_COLOR_MATERIAL
    _glPushMatrix
    _glTranslatef 0, ABS(h_map(50, 50).y + 1), 0
    objDraw pineMesh(), pineMeshInfo(), pineMeshFileInfo
    _glPopMatrix


    'snow
    _glDisable _GL_LIGHTING
    _glPointSize 8.0
    _glColor3f 1, 1, 1
    _glEnable _GL_COLOR_MATERIAL
    _glEnableClientState _GL_VERTEX_ARRAY
    _glVertexPointer 3, _GL_FLOAT, 24, _OFFSET(snow())
    _glDrawArrays _GL_POINTS, 1, UBOUND(snow)
    _glFlush
    clock = clock + 0.5
END SUB

SUB init_land ()
    DIM A AS vec3, B AS vec3, C AS vec3, R AS vec3
    max_vert_index = 0
    DO
        IF z MOD 2 = 0 THEN x = x + 1 ELSE x = x - 1

        A = h_map(x, z) 'get out coordinates from our stored data
        B = h_map(x, z + 1)
        C = h_map(x + 1, z)

        OBJ_CalculateNormal A, B, C, R 'calculates the normal of a triangle

        'store color, coordinate & normal data in an array
        map_norm(max_vert_index) = R.x: map_norm(max_vert_index + 1) = R.y: map_norm(max_vert_index + 2) = R.z
        map_vert(max_vert_index) = A.x: map_vert(max_vert_index + 1) = A.y: map_vert(max_vert_index + 2) = A.z

        map_norm(max_vert_index + 3) = R.x: map_norm(max_vert_index + 4) = R.y: map_norm(max_vert_index + 5) = R.z
        map_vert(max_vert_index + 3) = B.x: map_vert(max_vert_index + 4) = B.y: map_vert(max_vert_index + 5) = B.z

        max_vert_index = max_vert_index + 6

        IF x = max_w - 1 THEN
            IF z MOD 2 = 0 THEN x = x + 1: z = z + 1
        END IF
        IF x = 1 THEN
            IF z MOD 2 = 1 THEN x = x - 1: z = z + 1
        END IF
        IF z = max_h - 1 THEN EXIT DO
    LOOP
END SUB

SUB OBJ_CalculateNormal (p1 AS vec3, p2 AS vec3, p3 AS vec3, N AS vec3)
    DIM U AS vec3, V AS vec3

    U.x = p2.x - p1.x
    U.y = p2.y - p1.y
    U.z = p2.z - p1.z

    V.x = p3.x - p1.x
    V.y = p3.y - p1.y
    V.z = p3.z - p1.z

    N.x = (U.y * V.z) - (U.z * V.y)
    N.y = (U.z * V.x) - (U.x * V.z)
    N.z = (U.x * V.y) - (U.y * V.x)
    OBJ_Normalize N
END SUB

SUB OBJ_Normalize (V AS vec3)
    mag! = SQR(V.x * V.x + V.y * V.y + V.z * V.z)
    V.x = V.x / mag!
    V.y = V.y / mag!
    V.z = V.z / mag!
END SUB

'>>>>>>>>>>>> p5js.bas CONTENT START >>>>>>>>>>>>>>>>>>>>>>>>>>>
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

FUNCTION p5random! (mn!, mx!)
    IF mn! > mx! THEN
        SWAP mn!, mx!
    END IF
    p5random! = RND * (mx! - mn!) + mn!
END FUNCTION

FUNCTION noise! (x AS SINGLE, y AS SINGLE, z AS SINGLE)
    STATIC p5NoiseSetup AS _BYTE
    STATIC perlin() AS SINGLE
    STATIC PERLIN_YWRAPB AS SINGLE, PERLIN_YWRAP AS SINGLE
    STATIC PERLIN_ZWRAPB AS SINGLE, PERLIN_ZWRAP AS SINGLE
    STATIC PERLIN_SIZE AS SINGLE

    IF NOT p5NoiseSetup THEN
        p5NoiseSetup = -1

        PERLIN_YWRAPB = 4
        PERLIN_YWRAP = INT(1 * (2 ^ PERLIN_YWRAPB))
        PERLIN_ZWRAPB = 8
        PERLIN_ZWRAP = INT(1 * (2 ^ PERLIN_ZWRAPB))
        PERLIN_SIZE = 4095

        perlin_octaves = 4
        perlin_amp_falloff = 0.5

        REDIM perlin(PERLIN_SIZE + 1) AS SINGLE
        DIM i AS SINGLE
        FOR i = 0 TO PERLIN_SIZE + 1
            perlin(i) = RND
        NEXT
    END IF

    x = ABS(x)
    y = ABS(y)
    z = ABS(z)

    DIM xi AS SINGLE, yi AS SINGLE, zi AS SINGLE
    xi = INT(x)
    yi = INT(y)
    zi = INT(z)

    DIM xf AS SINGLE, yf AS SINGLE, zf AS SINGLE
    xf = x - xi
    yf = y - yi
    zf = z - zi

    DIM r AS SINGLE, ampl AS SINGLE, o AS SINGLE
    r = 0
    ampl = .5

    FOR o = 1 TO perlin_octaves
        DIM of AS SINGLE, rxf AS SINGLE
        DIM ryf AS SINGLE, n1 AS SINGLE, n2 AS SINGLE, n3 AS SINGLE
        of = xi + INT(yi * (2 ^ PERLIN_YWRAPB)) + INT(zi * (2 ^ PERLIN_ZWRAPB))

        rxf = 0.5 * (1.0 - COS(xf * _PI))
        ryf = 0.5 * (1.0 - COS(yf * _PI))

        n1 = perlin(of AND PERLIN_SIZE)
        n1 = n1 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n1)
        n2 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
        n2 = n2 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n2)
        n1 = n1 + ryf * (n2 - n1)

        of = of + PERLIN_ZWRAP
        n2 = perlin(of AND PERLIN_SIZE)
        n2 = n2 + rxf * (perlin((of + 1) AND PERLIN_SIZE) - n2)
        n3 = perlin((of + PERLIN_YWRAP) AND PERLIN_SIZE)
        n3 = n3 + rxf * (perlin((of + PERLIN_YWRAP + 1) AND PERLIN_SIZE) - n3)
        n2 = n2 + ryf * (n3 - n2)

        n1 = n1 + (0.5 * (1.0 - COS(zf * _PI))) * (n2 - n1)

        r = r + n1 * ampl
        ampl = ampl * perlin_amp_falloff
        xi = INT(xi * (2 ^ 1))
        xf = xf * 2
        yi = INT(yi * (2 ^ 1))
        yf = yf * 2
        zi = INT(zi * (2 ^ 1))
        zf = zf * 2

        IF xf >= 1.0 THEN xi = xi + 1: xf = xf - 1
        IF yf >= 1.0 THEN yi = yi + 1: yf = yf - 1
        IF zf >= 1.0 THEN zi = zi + 1: zf = zf - 1
    NEXT
    noise! = r
END FUNCTION

SUB noiseDetail (lod!, falloff!)
    IF lod! > 0 THEN perlin_octaves = lod!
    IF falloff! > 0 THEN perlin_amp_falloff = falloff!
END SUB

'>>>>>>>>>>>>> p5js.bas CONTENT END >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'->>>>>>> OBJ_LOADER_LIB.BAS CONTENT START>>>>>>>>>>>>>>

'An LIBRARY version of OBJ Loader
'Contain useful Functions/methods for your making your 3D Apps/Games

SUB internal_OBJ_types ()
    TYPE MDL_INFO
        num_of_vertices AS _UNSIGNED LONG
        num_of_normals AS _UNSIGNED LONG
        num_of_tex_coords AS _UNSIGNED LONG
        num_of_objects AS _UNSIGNED LONG
        num_of_faces AS _UNSIGNED LONG
        num_of_materials AS _UNSIGNED LONG
        materialPresent AS _BYTE
        mode AS INTEGER
    END TYPE


    TYPE material_info
        exits AS _BYTE 'material exits or not
        init AS _BYTE
        id AS STRING * 128 'material name
        amb AS vec3 'ambient
        diff AS vec3 'diffuse
        spec AS vec3 'specular
        emis AS vec3 'emission
        img_tex_name AS STRING * 128 'name of the image texture file name
        img_tex AS LONG 'image handle
        gl_tex AS LONG 'GL tex handle
        shine AS SINGLE 'shineness
        trans AS SINGLE 'transparency
    END TYPE

    TYPE mesh_part_info
        start AS _UNSIGNED LONG 'start index of mesh()
        length AS _UNSIGNED LONG 'length
        init AS _BYTE 'intialize?
        mtl AS material_info 'material properties
        origin AS vec3 'origin of each mesh_part
        atOrigin AS _BYTE 'is it at the origin
        hidden AS _BYTE 'if hidden, it will not render when calling with objDraw(). However, it can be made render by objDrawMeshPart()
    END TYPE

END SUB

SUB objHideMeshPart (which$, mesh_part() AS mesh_part_info)
    FOR i = 0 TO UBOUND(mesh_part)
        IF _TRIM$(mesh_part(i).mtl.id) = which$ THEN
            mesh_part(i).hidden = -1
            EXIT SUB
        END IF
    NEXT
END SUB

SUB objUnhideMeshPart (which$, mesh_part() AS mesh_part_info)
    FOR i = 0 TO UBOUND(mesh_part)
        IF _TRIM$(mesh_part(i).mtl.id) = which$ THEN
            mesh_part(i).hidden = 0
            EXIT SUB
        END IF
    NEXT
END SUB

SUB setMeshPartOrigin (which$, mesh_part() AS mesh_part_info, mesh() AS SINGLE)
    FOR i = 0 TO UBOUND(mesh_part)
        IF _TRIM$(mesh_part(i).mtl.id) = which$ THEN
            IF NOT mesh_part(i).atOrigin THEN
                FOR j = 8 * mesh_part(i).start TO 8 * (mesh_part(i).start + mesh_part(i).length - 1) STEP 8
                    mesh(j) = mesh(j) - mesh_part(i).origin.x
                    mesh(j + 1) = mesh(j + 1) - mesh_part(i).origin.y
                    mesh(j + 2) = mesh(j + 2) - mesh_part(i).origin.z
                NEXT
                mesh_part(i).atOrigin = -1
            END IF
            _glTranslatef mesh_part(i).origin.x, mesh_part(i).origin.y, mesh_part(i).origin.z
            ' ? mesh_part(i).origin.x,mesh_part(i).origin.y,mesh_part(i).origin.z
            EXIT SUB
        END IF
    NEXT
END SUB

SUB resetMeshPartOrigin (which$, mesh_part() AS mesh_part_info, mesh() AS SINGLE)
    FOR i = 0 TO UBOUND(mesh_part)
        IF _TRIM$(mesh_part(i).mtl.id) = which$ THEN
            IF mesh_part(i).atOrigin THEN
                FOR j = 8 * mesh_part(i).start TO 8 * (mesh_part(i).start + mesh_part(i).length - 1) STEP 8
                    mesh(j) = mesh(j) + mesh_part(i).origin.x
                    mesh(j + 1) = mesh(j + 1) + mesh_part(i).origin.y
                    mesh(j + 2) = mesh(j + 2) + mesh_part(i).origin.z
                NEXT
                mesh_part(i).atOrigin = 0
            END IF
            EXIT SUB
        END IF
    NEXT
END SUB

SUB objImportBin (inFile$, mesh() AS SINGLE, mesh_part() AS mesh_part_info, mdl_info AS MDL_INFO)
    REDIM mesh(0) AS SINGLE, mesh_part(0) AS mesh_part_info
    x = _INSTRREV(inFile$, "/") + _INSTRREV(inFile$, "\")
    DIM path$, count AS _UNSIGNED LONG
    path$ = LEFT$(inFile$, x)

    f = FREEFILE

    OPEN inFile$ FOR BINARY AS #f
    GET #f, , mdl_info
    GET #f, , count
    REDIM mesh_part(count) AS mesh_part_info
    GET #f, , mesh_part()
    GET #f, , count
    REDIM mesh(count) AS SINGLE
    GET #f, , mesh()
    CLOSE #f

    FOR i = 0 TO UBOUND(mesh_part)
        mesh_part(i).mtl.img_tex = 0
        mesh_part(i).mtl.gl_tex = 0
        mesh_part(i).mtl.img_tex = _LOADIMAGE(path$ + _TRIM$(mesh_part(i).mtl.img_tex_name))
    NEXT
END SUB

SUB objExportBin (outFile$, mesh() AS SINGLE, mesh_part() AS mesh_part_info, mdl_info AS MDL_INFO)
    IF _FILEEXISTS(outFile$) THEN KILL outFile$
    DIM count AS _UNSIGNED LONG, mn AS vec3, mx AS vec3

    'just to calculate origin of each mesh part by simple the mean of their max & min position vector
    FOR i = 0 TO UBOUND(mesh_part)
        ' ? "ID : ";_TRIM$(mesh_part(i).mtl.id)
        count = 8 * mesh_part(i).start
        mn.x = mesh(count): mn.y = mesh(count + 1): mn.z = mesh(count + 2)
        mx.x = mesh(count): mx.y = mesh(count + 1): mx.z = mesh(count + 2)
        ' ? "Max : (";mx.x;",";mx.y;",";mx.z;")"
        ' ? "Min : (";mn.x;",";mn.y;",";mn.z;")"
        FOR j = count TO count + 8 * (mesh_part(i).length - 1) STEP 8
            IF mn.x >= mesh(j) THEN mn.x = mesh(j)
            IF mn.y >= mesh(j + 1) THEN mn.y = mesh(j + 1)
            IF mn.z >= mesh(j + 2) THEN mn.z = mesh(j + 2)

            IF mx.x <= mesh(j) THEN mx.x = mesh(j)
            IF mx.y <= mesh(j + 1) THEN mx.y = mesh(j + 1)
            IF mx.z <= mesh(j + 2) THEN mx.z = mesh(j + 2)
        NEXT
        ' ? "Max : (";mx.x;",";mx.y;",";mx.z;")"
        ' ? "Min : (";mn.x;",";mn.y;",";mn.z;")"
        ' sleep
        mesh_part(i).origin.x = (mn.x + mx.x) * 0.5
        mesh_part(i).origin.y = (mn.y + mx.y) * 0.5
        mesh_part(i).origin.z = (mn.z + mx.z) * 0.5

    NEXT

    f = FREEFILE
    OPEN outFile$ FOR BINARY AS #f
    PUT #f, , mdl_info 'MODEL GENERAL INFO
    count = UBOUND(mesh_part) 'length of mesh_part() array
    PUT #f, , count
    PUT #f, , mesh_part()
    count = UBOUND(mesh) 'length of mesh() array
    PUT #f, , count
    PUT #f, , mesh()
    CLOSE #f
END SUB

SUB objInit (mesh_part() AS mesh_part_info)
    FOR i = 0 TO UBOUND(mesh_part)
        IF mesh_part(i).mtl.img_tex < -1 THEN mesh_part(i).mtl.gl_tex = feedGLTexture(mesh_part(i).mtl.img_tex)
    NEXT
END SUB

SUB objDrawMeshPart (which$, mesh() AS SINGLE, mesh_part() AS mesh_part_info, mdl_info AS MDL_INFO)
    FOR i = 0 TO UBOUND(mesh_part)
        IF which$ = _TRIM$(mesh_part(i).mtl.id) THEN
            IF mesh_part(i).mtl.trans = 1 THEN _glDisable _GL_BLEND ELSE _glEnable _GL_BLEND
            _glMaterialfv _GL_FRONT, _GL_AMBIENT, glVec4(mesh_part(i).mtl.amb.x, mesh_part(i).mtl.amb.y, mesh_part(i).mtl.amb.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_DIFFUSE, glVec4(mesh_part(i).mtl.diff.x, mesh_part(i).mtl.diff.y, mesh_part(i).mtl.diff.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_SPECULAR, glVec4(mesh_part(i).mtl.spec.x, mesh_part(i).mtl.spec.y, mesh_part(i).mtl.spec.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_EMISSION, glVec4(mesh_part(i).mtl.emis.x, mesh_part(i).mtl.emis.y, mesh_part(i).mtl.emis.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_SHININESS, glVec4(mesh_part(i).mtl.shine * 0.128, 0, 0, 0)
            _glEnableClientState _GL_VERTEX_ARRAY
            _glVertexPointer 3, _GL_FLOAT, 32, _OFFSET(mesh()) + 32 * mesh_part(i).start
            IF mdl_info.num_of_tex_coords > 0 THEN
                selectTexture mesh_part(i).mtl.gl_tex
                _glEnableClientState _GL_TEXTURE_COORD_ARRAY
                _glTexCoordPointer 3, _GL_FLOAT, 32, _OFFSET(mesh()) + 12 + 32 * mesh_part(i).start
            END IF
            IF mdl_info.num_of_normals > 0 THEN
                _glEnableClientState _GL_NORMAL_ARRAY
                _glNormalPointer _GL_FLOAT, 32, _OFFSET(mesh()) + 20 + 32 * mesh_part(i).start
            END IF
            IF mdl_info.mode = 1 THEN _glDrawArrays _GL_TRIANGLES, 0, mesh_part(i).length
            IF mdl_info.mode = 2 THEN _glDrawArrays _GL_LINES, 0, mesh_part(i).length

            EXIT SUB
        END IF
    NEXT
    _glDisableClientState _GL_VERTEX_ARRAY
    _glDisableClientState _GL_NORMAL_ARRAY
    _glDisableClientState _GL_TEXTURE_COORD_ARRAY
END SUB
SUB objDraw (mesh() AS SINGLE, mesh_part() AS mesh_part_info, mdl_info AS MDL_INFO)
    FOR i = 0 TO UBOUND(mesh_part) 'draw the mesh
        IF mesh_part(i).hidden THEN _CONTINUE 'no need to draw the hidden/unactive part (if there)
        IF mdl_info.materialPresent = 1 THEN
            IF mesh_part(i).mtl.trans = 1 THEN _glDisable _GL_BLEND ELSE _glEnable _GL_BLEND
            _glMaterialfv _GL_FRONT, _GL_AMBIENT, glVec4(mesh_part(i).mtl.amb.x, mesh_part(i).mtl.amb.y, mesh_part(i).mtl.amb.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_DIFFUSE, glVec4(mesh_part(i).mtl.diff.x, mesh_part(i).mtl.diff.y, mesh_part(i).mtl.diff.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_SPECULAR, glVec4(mesh_part(i).mtl.spec.x, mesh_part(i).mtl.spec.y, mesh_part(i).mtl.spec.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_EMISSION, glVec4(mesh_part(i).mtl.emis.x, mesh_part(i).mtl.emis.y, mesh_part(i).mtl.emis.z, mesh_part(i).mtl.trans)
            _glMaterialfv _GL_FRONT, _GL_SHININESS, glVec4(mesh_part(i).mtl.shine * 0.128, 0, 0, 0)
        END IF
        _glEnableClientState _GL_VERTEX_ARRAY
        _glVertexPointer 3, _GL_FLOAT, 32, _OFFSET(mesh()) + 32 * mesh_part(i).start
        IF mdl_info.num_of_tex_coords > 0 THEN
            selectTexture mesh_part(i).mtl.gl_tex
            _glEnableClientState _GL_TEXTURE_COORD_ARRAY
            _glTexCoordPointer 3, _GL_FLOAT, 32, _OFFSET(mesh()) + 12 + 32 * mesh_part(i).start
        END IF
        IF mdl_info.num_of_normals > 0 THEN
            _glEnableClientState _GL_NORMAL_ARRAY
            _glNormalPointer _GL_FLOAT, 32, _OFFSET(mesh()) + 20 + 32 * mesh_part(i).start
        END IF
        IF mdl_info.mode = 1 THEN _glDrawArrays _GL_TRIANGLES, 0, mesh_part(i).length
        IF mdl_info.mode = 2 THEN _glDrawArrays _GL_LINES, 0, mesh_part(i).length
    NEXT
    _glDisableClientState _GL_VERTEX_ARRAY
    _glDisableClientState _GL_NORMAL_ARRAY
    _glDisableClientState _GL_TEXTURE_COORD_ARRAY
END SUB

SUB objLoad (f$, mesh() AS SINGLE, mesh_part() AS mesh_part_info, mdl_info AS MDL_INFO)
    'seprate file name and path
    x = _INSTRREV(f$, "/") + _INSTRREV(f$, "\")
    IF x = 0 THEN
        obj_file$ = f$
    ELSE
        obj_file$ = RIGHT$(f$, LEN(f$) - x)
        path$ = LEFT$(f$, x)
    END IF

    DIM tag(4) AS STRING * 3, p(4) AS _UNSIGNED LONG 'tag() contain keywords like v, vt, etc. p() store the position for each keywords independently
    DIM v(4) AS _UNSIGNED LONG 'v(0) -> no. of vertices, v(1)->no. of tex. coord.,v(2)->no. of normals, v(3)->no. of faces
    REDIM vert(2) AS SINGLE, norm(2) AS SINGLE, texcoord(1) AS SINGLE 'vert(), norm() and texcoord() will store all the vertices, normals and texture coordinates()
    REDIM mesh(23) AS SINGLE '(3 vert + 2 tex coord + 3 norm )* 3 vert of triangle : This is the main data which we will pass to OpenGL
    REDIM materials(0) AS material_info, mesh_part(0) AS mesh_part_info 'contain properties of mesh like materials
    DIM materialPresent

    tag(0) = CHR$(10) + "v ": tag(1) = CHR$(10) + "vt": tag(2) = CHR$(10) + "vn": tag(3) = CHR$(10) + "f ": tag(4) = CHR$(10) + "o "
    DIM LINE_FEED AS STRING * 1
    LINE_FEED = CHR$(10)
    OPEN f$ FOR BINARY AS #1
    length = LOF(1)
    a$ = SPACE$(length)
    GET #1, , a$
    CLOSE #1

    'check if the mtl file exits for the given OBJ
    x = INSTR(1, a$, LINE_FEED + "mtllib")
    IF x THEN 'yes it exits
        FOR i = x + 8 TO LEN(a$)
            IF MID$(a$, i, 1) = CHR$(13) OR MID$(a$, i, 1) = LINE_FEED THEN y = i: EXIT FOR
        NEXT
        mtl_file$ = path$ + _TRIM$(MID$(a$, x + 8, y - (x + 8)))
        IF NOT _FILEEXISTS(mtl_file$) THEN PRINT "ERROR : File not found - " + mtl_file$: END
        x = 1
        materialPresent = 1
        mtl_index = -1 'so it start with 0 in the loop
        OPEN mtl_file$ FOR INPUT AS #2
        WHILE NOT EOF(2)
            LINE INPUT #2, b$
            IF LEFT$(b$, 1) <> "#" THEN 'to avoid comments. Comments in OBJ/MTL start with #
                IF LEFT$(b$, 6) = "newmtl" THEN 'new material
                    mtl_index = mtl_index + 1
                    REDIM _PRESERVE materials(mtl_index) AS material_info
                    materials(mtl_index).id = _TRIM$(MID$(b$, 7, LEN(b$) - 6))
                    materials(mtl_index).exits = 1
                ELSEIF LEFT$(b$, 2) = "Ka" THEN 'ambient
                    y1 = INSTR(4, b$, " ")
                    y2 = INSTR(y1 + 1, b$, " ")
                    materials(mtl_index).amb.x = VAL(MID$(b$, 4, y1 - 3))
                    materials(mtl_index).amb.y = VAL(MID$(b$, y1, y2 - y1 + 1))
                    materials(mtl_index).amb.z = VAL(RIGHT$(b$, LEN(b$) - y2 + 1))
                ELSEIF LEFT$(b$, 2) = "Kd" THEN 'diffuse
                    y1 = INSTR(4, b$, " ")
                    y2 = INSTR(y1 + 1, b$, " ")
                    materials(mtl_index).diff.x = VAL(MID$(b$, 4, y1 - 3))
                    materials(mtl_index).diff.y = VAL(MID$(b$, y1, y2 - y1 + 1))
                    materials(mtl_index).diff.z = VAL(RIGHT$(b$, LEN(b$) - y2 + 1))
                ELSEIF LEFT$(b$, 2) = "Ks" THEN 'specular
                    y1 = INSTR(4, b$, " ")
                    y2 = INSTR(y1 + 1, b$, " ")
                    materials(mtl_index).spec.x = VAL(MID$(b$, 4, y1 - 3))
                    materials(mtl_index).spec.y = VAL(MID$(b$, y1, y2 - y1 + 1))
                    materials(mtl_index).spec.z = VAL(RIGHT$(b$, LEN(b$) - y2 + 1))
                ELSEIF LEFT$(b$, 2) = "Ke" THEN 'emission
                    y1 = INSTR(4, b$, " ")
                    y2 = INSTR(y1 + 1, b$, " ")
                    materials(mtl_index).emis.x = VAL(MID$(b$, 4, y1 - 3))
                    materials(mtl_index).emis.y = VAL(MID$(b$, y1, y2 - y1 + 1))
                    materials(mtl_index).emis.z = VAL(RIGHT$(b$, LEN(b$) - y2 + 1))
                ELSEIF LEFT$(b$, 2) = "Ns" THEN 'shineness
                    materials(mtl_index).shine = VAL(MID$(b$, 3, LEN(b$) - 2))
                ELSEIF LEFT$(b$, 2) = "d " THEN 'transparency
                    materials(mtl_index).trans = VAL(MID$(b$, 2, LEN(b$) - 1))
                ELSEIF LEFT$(b$, 6) = "map_Kd" THEN 'texture file name
                    img_file$ = path$ + _TRIM$(MID$(b$, 7, LEN(b$) - 6))
                    materials(mtl_index).img_tex_name = _TRIM$(MID$(b$, 7, LEN(b$) - 6))
                    dummy_img& = _LOADIMAGE(img_file$)
                    IF NOT dummy_img& < -1 THEN PRINT "ERROR : Could not load the texture - " + img_file$: END
                    materials(mtl_index).img_tex = dummy_img&
                END IF
            END IF
        WEND
        CLOSE #2
    END IF

    p(0) = 1: p(1) = 1: p(2) = 1: p(3) = 1: p(4) = 1
    'get position of first mention of material to be used
    mtl_first = INSTR(1, a$, LINE_FEED + "usemtl"): mtl_second = INSTR(mtl_first + 1, a$, LINE_FEED + "usemtl")
    mtl_id$ = _TRIM$(MID$(a$, mtl_first + 8, INSTR(mtl_first + 8, a$, LINE_FEED) - (mtl_first + 8)))
    FOR j = 0 TO UBOUND(materials)
        IF RTRIM$(materials(j).id) = mtl_id$ THEN mtl_index = j: EXIT FOR
    NEXT
    'This is the main loop of reading the file. It does all the things which is required.
    DO
        x = INSTR(p(c), a$, tag(c))
        IF x > 0 THEN
            v(c) = v(c) + 1
            IF c = 0 THEN 'store vertices
                y1 = INSTR(x + 3, a$, " ")
                y2 = INSTR(y1 + 1, a$, " ")
                y3 = INSTR(y2 + 1, a$, LINE_FEED)
                vert(v_index) = VAL(MID$(a$, x + 3, y1 - (x + 3)))
                vert(v_index + 1) = VAL(MID$(a$, y1, y2 - y1))
                vert(v_index + 2) = VAL(MID$(a$, y2, y3 - y2))
                v_index = v_index + 3
                REDIM _PRESERVE vert(UBOUND(vert) + 3) AS SINGLE
            ELSEIF c = 1 THEN 'store tex coord.
                y1 = INSTR(x + 4, a$, " ")
                y2 = INSTR(y1 + 1, a$, LINE_FEED)
                texcoord(vt_index) = VAL(MID$(a$, x + 4, y1 - (x + 4)))
                texcoord(vt_index + 1) = -VAL(MID$(a$, y1, y2 - y1))
                vt_index = vt_index + 2
                REDIM _PRESERVE texcoord(UBOUND(texcoord) + 2) AS SINGLE
            ELSEIF c = 2 THEN 'store normals
                y1 = INSTR(x + 4, a$, " ")
                y2 = INSTR(y1 + 1, a$, " ")
                y3 = INSTR(y2 + 1, a$, LINE_FEED)
                norm(vn_index) = VAL(MID$(a$, x + 4, y1 - (x + 4)))
                norm(vn_index + 1) = VAL(MID$(a$, y1, y2 - y1))
                norm(vn_index + 2) = VAL(MID$(a$, y2, y3 - y2))
                vn_index = vn_index + 3
                REDIM _PRESERVE norm(UBOUND(norm) + 3) AS SINGLE
            ELSEIF c = 3 THEN 'face part
                'check if there is new material to be used for face. If not then array length for current mesh_info() increases
                check_for_obj:
                IF x > mtl_first AND x < mtl_second OR mtl_second = 0 THEN
                    IF mesh_part(mp_index).init = 0 THEN mesh_part(mp_index).init = 1: mesh_part(mp_index).start = m_index / 8: mesh_part(mp_index).mtl = materials(mtl_index)
                    mesh_part(mp_index).length = mesh_part(mp_index).length + 3 '3 vertex in a face
                ELSE
                    mtl_first = mtl_second
                    mtl_second = INSTR(mtl_first + 1, a$, LINE_FEED + "usemtl")
                    mtl_id$ = _TRIM$(MID$(a$, mtl_first + 8, INSTR(mtl_first + 8, a$, LINE_FEED) - (mtl_first + 8)))
                    FOR j = 0 TO UBOUND(materials)
                        IF RTRIM$(materials(j).id) = mtl_id$ THEN mtl_index = j: EXIT FOR
                    NEXT
                    mp_index = mp_index + 1
                    REDIM _PRESERVE mesh_part(mp_index) AS mesh_part_info
                    GOTO check_for_obj
                END IF
                'reading of face data comes heer
                spc_1 = x + 2: spc_2 = INSTR(spc_1 + 1, a$, " ")
                y_max = INSTR(x + 1, a$, LINE_FEED)

                n = -1 'so start with 0 in while loop
                'get the each vertex info block which are sperated by space
                REDIM dat(0) AS STRING
                WHILE 1 'spc_2<y_max
                    n = n + 1
                    REDIM _PRESERVE dat(n) AS STRING
                    IF spc_2 >= y_max OR spc_2 < spc_1 THEN
                        dat(n) = MID$(a$, spc_1 + 1, y_max - (spc_1 + 1))
                        EXIT WHILE
                    ELSE
                        dat(n) = MID$(a$, spc_1 + 1, spc_2 - (spc_1 + 1))
                    END IF
                    SWAP spc_1, spc_2
                    spc_2 = INSTR(spc_1 + 1, a$, " ")
                WEND

                REDIM z_ref(n, 1) AS INTEGER
                'get ref info for v,vt,vn
                FOR i = 0 TO n
                    z_ref(i, 0) = INSTR(1, dat(i), "/")
                    z_ref(i, 1) = _INSTRREV(dat(i), "/")
                NEXT

                IF z_ref(0, 0) = 0 THEN 'only v data given
                    IF (n + 1) > 3 THEN 'polygon face given : So, subdivide the polygon in minimum no. of triangles
                        v_r1 = (VAL(dat(0)) - 1) * 3
                        FOR i = 3 TO (n + 1)
                            v_r2 = (VAL(dat(i - 2)) - 1) * 3
                            v_r3 = (VAL(dat(i - 1)) - 1) * 3
                            mesh(m_index) = vert(v_r1): mesh(m_index + 1) = vert(v_r1 + 1): mesh(m_index + 2) = vert(v_r1 + 2)
                            m_index = m_index + 8
                            mesh(m_index) = vert(v_r2): mesh(m_index + 1) = vert(v_r2 + 1): mesh(m_index + 2) = vert(v_r2 + 2)
                            m_index = m_index + 8
                            mesh(m_index) = vert(v_r3): mesh(m_index + 1) = vert(v_r3 + 1): mesh(m_index + 2) = vert(v_r3 + 2)
                            m_index = m_index + 8
                            REDIM _PRESERVE mesh(UBOUND(mesh) + 24) AS SINGLE
                        NEXT
                        'add additional new vertices
                        mesh_part(mp_index).length = mesh_part(mp_index).length + 3 * (n - 2) '3*(X - 2) - 3 => 3*(X - 3), now here X = n+1, so, 3*(n-2)
                    ELSE 'simply a triangle face
                        FOR j = 0 TO 2
                            v_r1 = (VAL(dat(j)) - 1) * 3
                            mesh(m_index) = vert(v_r1): mesh(m_index + 1) = vert(v_r1 + 1): mesh(m_index + 2) = vert(v_r1 + 2)
                            m_index = m_index + 8
                        NEXT
                        REDIM _PRESERVE mesh(UBOUND(mesh) + 24) AS SINGLE
                    END IF
                ELSEIF z_ref(0, 1) - z_ref(0, 0) = 1 THEN 'only v and vn data given
                    IF (n + 1) > 3 THEN
                        v_r1 = (VAL(LEFT$(dat(0), z_ref(0, 0))) - 1) * 3
                        vn_r1 = (VAL(RIGHT$(dat(0), LEN(dat(0)) - z_ref(0, 1))) - 1) * 3
                        FOR i = 3 TO (n + 1)
                            v_r2 = (VAL(LEFT$(dat(i - 2), z_ref(i - 2, 0))) - 1) * 3: vn_r2 = (VAL(RIGHT$(dat(i - 2), LEN(dat(i - 2)) - z_ref((i - 2), 1))) - 1) * 3
                            v_r3 = (VAL(LEFT$(dat(i - 1), z_ref(i - 1, 0))) - 1) * 3: vn_r3 = (VAL(RIGHT$(dat(i - 1), LEN(dat(i - 1)) - z_ref((i - 1), 1))) - 1) * 3

                            mesh(m_index) = vert(v_r1): mesh(m_index + 1) = vert(v_r1 + 1): mesh(m_index + 2) = vert(v_r1 + 2)
                            mesh(m_index + 5) = norm(vn_r1): mesh(m_index + 6) = norm(vn_r1 + 1): mesh(m_index + 7) = norm(vn_r1 + 2)
                            m_index = m_index + 8
                            mesh(m_index) = vert(v_r2): mesh(m_index + 1) = vert(v_r2 + 1): mesh(m_index + 2) = vert(v_r2 + 2)
                            mesh(m_index + 5) = norm(vn_r2): mesh(m_index + 6) = norm(vn_r2 + 1): mesh(m_index + 7) = norm(vn_r2 + 2)
                            m_index = m_index + 8
                            mesh(m_index) = vert(v_r3): mesh(m_index + 1) = vert(v_r3 + 1): mesh(m_index + 2) = vert(v_r3 + 2)
                            mesh(m_index + 5) = norm(vn_r3): mesh(m_index + 6) = norm(vn_r3 + 1): mesh(m_index + 7) = norm(vn_r3 + 2)
                            m_index = m_index + 8
                            REDIM _PRESERVE mesh(UBOUND(mesh) + 24) AS SINGLE
                        NEXT
                        'add additional new vertices
                        mesh_part(mp_index).length = mesh_part(mp_index).length + 3 * (n - 2) '3*(X - 2) - 3 => 3*(X - 3), now here X = n+1, so, 3*(n-2)
                    ELSE
                        FOR j = 0 TO 2
                            v_r1 = (VAL(LEFT$(dat(j), z_ref(j, 0) - 1)) - 1) * 3: vn_r1 = (VAL(RIGHT$(dat(j), LEN(dat(j)) - z_ref(j, 1))) - 1) * 3
                            'v
                            mesh(m_index) = vert(v_r1): mesh(m_index + 1) = vert(v_r1 + 1): mesh(m_index + 2) = vert(v_r1 + 2)
                            'vn
                            mesh(m_index + 5) = norm(vn_r1): mesh(m_index + 6) = norm(vn_r1 + 1): mesh(m_index + 7) = norm(vn_r1 + 2)
                            m_index = m_index + 8
                        NEXT
                        REDIM _PRESERVE mesh(UBOUND(mesh) + 24) AS SINGLE
                    END IF
                ELSE 'v, vn and vt data given
                    IF (n + 1) > 3 THEN
                        'reference for first vertex of a polygon
                        v_r1 = (VAL(LEFT$(dat(0), z_ref(0, 0))) - 1) * 3
                        vn_r1 = (VAL(RIGHT$(dat(0), LEN(dat(0)) - z_ref(0, 1))) - 1) * 3
                        vt_r1 = (VAL(MID$(dat(0), z_ref(0, 0) + 1, z_ref(0, 1) - (z_ref(0, 0) + 1))) - 1) * 2
                        FOR i = 3 TO (n + 1)
                            v_r2 = (VAL(LEFT$(dat(i - 2), z_ref(i - 2, 0))) - 1) * 3: vn_r2 = (VAL(RIGHT$(dat(i - 2), LEN(dat(i - 2)) - z_ref((i - 2), 1))) - 1) * 3: vt_r2 = (VAL(MID$(dat(i - 2), z_ref(i - 2, 0) + 1, z_ref(i - 2, 1) - (z_ref(i - 2, 0) + 1))) - 1) * 2
                            v_r3 = (VAL(LEFT$(dat(i - 1), z_ref(i - 1, 0))) - 1) * 3: vn_r3 = (VAL(RIGHT$(dat(i - 1), LEN(dat(i - 1)) - z_ref((i - 1), 1))) - 1) * 3: vt_r3 = (VAL(MID$(dat(i - 1), z_ref(i - 1, 0) + 1, z_ref(i - 1, 1) - (z_ref(i - 1, 0) + 1))) - 1) * 2
                            mesh(m_index) = vert(v_r1): mesh(m_index + 1) = vert(v_r1 + 1): mesh(m_index + 2) = vert(v_r1 + 2)
                            mesh(m_index + 3) = texcoord(vt_r1): mesh(m_index + 4) = texcoord(vt_r1 + 1)
                            mesh(m_index + 5) = norm(vn_r1): mesh(m_index + 6) = norm(vn_r1 + 1): mesh(m_index + 7) = norm(vn_r1 + 2)
                            m_index = m_index + 8
                            mesh(m_index) = vert(v_r2): mesh(m_index + 1) = vert(v_r2 + 1): mesh(m_index + 2) = vert(v_r2 + 2)
                            mesh(m_index + 3) = texcoord(vt_r2): mesh(m_index + 4) = texcoord(vt_r2 + 1)
                            mesh(m_index + 5) = norm(vn_r2): mesh(m_index + 6) = norm(vn_r2 + 1): mesh(m_index + 7) = norm(vn_r2 + 2)
                            m_index = m_index + 8
                            mesh(m_index) = vert(v_r3): mesh(m_index + 1) = vert(v_r3 + 1): mesh(m_index + 2) = vert(v_r3 + 2)
                            mesh(m_index + 3) = texcoord(vt_r3): mesh(m_index + 4) = texcoord(vt_r3 + 1)
                            mesh(m_index + 5) = norm(vn_r3): mesh(m_index + 6) = norm(vn_r3 + 1): mesh(m_index + 7) = norm(vn_r3 + 2)
                            m_index = m_index + 8
                            REDIM _PRESERVE mesh(UBOUND(mesh) + 24) AS SINGLE
                        NEXT
                        mesh_part(mp_index).length = mesh_part(mp_index).length + 3 * (n - 2) '3*(X - 2) - 3 => 3*(X - 3), now here X = n+1, so, 3*(n-2)
                    ELSE
                        FOR j = 0 TO 2
                            v_r1 = (VAL(LEFT$(dat(j), z_ref(j, 0) - 1)) - 1) * 3: vn_r1 = (VAL(RIGHT$(dat(j), LEN(dat(j)) - z_ref(j, 1))) - 1) * 3: vt_r1 = (VAL(MID$(dat(j), z_ref(j, 0) + 1, z_ref(j, 1) - (z_ref(j, 0) + 1))) - 1) * 2
                            'v
                            mesh(m_index) = vert(v_r1): mesh(m_index + 1) = vert(v_r1 + 1): mesh(m_index + 2) = vert(v_r1 + 2)
                            'vt
                            mesh(m_index + 3) = texcoord(vt_r1): mesh(m_index + 4) = texcoord(vt_r1 + 1)
                            'vn
                            mesh(m_index + 5) = norm(vn_r1): mesh(m_index + 6) = norm(vn_r1 + 1): mesh(m_index + 7) = norm(vn_r1 + 2)
                            m_index = m_index + 8
                        NEXT
                        REDIM _PRESERVE mesh(UBOUND(mesh) + 24) AS SINGLE
                    END IF
                END IF

                ERASE dat, z_ref
            END IF
            p(c) = x + 1
        ELSE
            IF c = 4 THEN EXIT DO ELSE c = c + 1
        END IF
        x = 0
    LOOP

    mdl_info.num_of_vertices = v(0)
    mdl_info.num_of_tex_coords = v(1)
    mdl_info.num_of_normals = v(2)
    mdl_info.num_of_objects = v(4)
    mdl_info.num_of_faces = v(3)
    mdl_info.num_of_materials = UBOUND(materials) + 1
    mdl_info.materialPresent = materialPresent
    mdl_info.mode = 1
    ERASE vert, norm, texcoord 'not require now. So save memory whenever possible.
    a$ = ""
END SUB

'################# Internal Functions ##################################

FUNCTION feedGLTexture& (img AS LONG)
    IF img < -1 THEN
        DIM m AS _MEM
        m = _MEMIMAGE(img)

        _glGenTextures 1, _OFFSET(feedGLTexture&)
        _glBindTexture _GL_TEXTURE_2D, feedGLTexture&

        _glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGBA, _WIDTH(img&), _HEIGHT(img&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET

        _MEMFREE m
        _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR
        _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST

    ELSE
        PRINT "FUNCTION feedGlTexture&() : invalid image handle passed"
    END IF
END FUNCTION

SUB selectTexture (tex&)
    _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR
    _glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR
    _glBindTexture _GL_TEXTURE_2D, tex&
END SUB

FUNCTION glVec4%& (x, y, z, w)
    STATIC internal_vec4(3)
    internal_vec4(0) = x
    internal_vec4(1) = y
    internal_vec4(2) = z
    internal_vec4(3) = w
    glVec4%& = _OFFSET(internal_vec4())
END FUNCTION
'>>>>>>>>>>> OBJ_LOADER_LIB.BAS CONTENT END >>>>>>>>>>>>>>>>>>>>>>>>>>>

'============================================================
'=== This file was created with MakeDATA.bas by RhoSigma, ===
'=== you must $INCLUDE this at the end of your program.   ===
'============================================================

'=====================================================================
'Function to write the embedded DATAs back to disk. Call this FUNCTION
'once, before you will access the represented file for the first time.
'After the call always use the returned realFile$ ONLY to access the
'written file, as the filename was maybe altered in order to avoid the
'overwriting of an existing file of the same name in the given location.
'---------------------------------------------------------------------
'SYNTAX: realFile$ = Writetree.basData$ (wantFile$)
'
'INPUTS: wantFile$ --> The filename you would like to write the DATAs
'                      to, can contain a full or relative path.
'
'RESULT: realFile$ --> On success the path and filename finally used
'                      after applied checks, use ONLY this returned
'                      name to access the file.
'                   -> On failure this FUNCTION will panic with the
'                      appropriate ERROR code, you may handle this as
'                      needed with your own ON ERROR GOTO... handler.
'=====================================================================
FUNCTION Writetree.basData$ (file$)
    '--- separate filename body & extension ---
    FOR po% = LEN(file$) TO 1 STEP -1
        IF MID$(file$, po%, 1) = "." THEN
            body$ = LEFT$(file$, po% - 1)
            ext$ = MID$(file$, po%)
            EXIT FOR
        ELSEIF MID$(file$, po%, 1) = "\" OR MID$(file$, po%, 1) = "/" OR po% = 1 THEN
            body$ = file$
            ext$ = ""
            EXIT FOR
        END IF
    NEXT po%
    '--- avoid overwriting of existing files ---
    num% = 1
    WHILE _FILEEXISTS(file$)
        file$ = body$ + "(" + LTRIM$(STR$(num%)) + ")" + ext$
        num% = num% + 1
    WEND
    '--- write DATAs ---
    ff% = FREEFILE
    OPEN file$ FOR OUTPUT AS ff%
    RESTORE tree.bas
    READ numL&, numB&
    FOR i& = 1 TO numL&
        READ dat&
        PRINT #ff%, MKL$(dat&);
    NEXT i&
    IF numB& > 0 THEN
        FOR i& = 1 TO numB&
            READ dat&
            PRINT #ff%, CHR$(dat&);
        NEXT i&
    END IF
    CLOSE ff%
    '--- set result ---
    Writetree.basData$ = file$
    EXIT FUNCTION

    '--- DATAs representing the contents of file tree.binobj
    '---------------------------------------------------------------------
    tree.bas:
    DATA 2056,7
    DATA &H0000002F,&H00000026,&H00000000,&H00000005,&H00000025,&H00000002,&H03000101,&H00000000
    DATA &H2A000000,&H01000000,&H614D0001,&H69726574,&H302E6C61,&H20203130,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H00002020,&H00003F80,&H00003F80,&H2B563F80,&H8B593E33,&H00003F07
    DATA &H00000000,&H999A0000,&H00003F19,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H28280000,&H000042C0,&H00003F80,&H7E020000,&H000040A9,&H00000000,&H0000002A,&H0000002A
    DATA &H4D000101,&H72657461,&H2E6C6169,&H20313030,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H00202020,&H003F8000,&H003F8000,&H563F8000,&H593E332B,&H003F078B,&H00000000,&H9A000000
    DATA &H003F1999,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H28000000,&H0042C028
    DATA &H003F8000,&HD5000000,&H00408258,&H00000000,&H00005400,&H00002A00,&H00010100,&H6574614D
    DATA &H6C616972,&H3130302E,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H3F800000
    DATA &H3F800000,&H3F800000,&H3E332B56,&H3F078B59,&H00000000,&H00000000,&H3F19999A,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H42C02828,&H3F800000,&H00000000
    DATA &H402F8672,&H00000000,&H007E0000,&H00540000,&H01010000,&H74614D00,&H61697265,&H30302E6C
    DATA &H20202032,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H20202020
    DATA &H20202020,&H20202020,&H20202020,&H20202020,&H20202020,&H80000020,&H8000003F,&H8000003F
    DATA &H3A09033F,&HB0CDC83F,&H1DBCA93E,&H0000003D,&H0000003F,&H0000003F,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&HC0282800,&H80000042,&H0000003F,&H00000000,&H00000000
    DATA &HA7000000,&H66000006,&H36BF782E,&H00408A78,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&HCF000000,&H0040C883,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H95BEB1DE,&H36BF2F7D,&H95408A78,&H00BF2F7D,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&HCF000000,&H0040C883,&H00000000,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H95BF56B5,&H363F2F7D,&H95408A78,&H00BF2F7D,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H95BF56B5,&H36BF2F7D,&H95408A78,&H003F2F7D,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H003EB1DE,&HCF000000,&H0040C883,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H663EB1DE,&H36BF782E,&H00408A78,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H003EB1DE,&H36000000,&H66408A78,&H003F782E,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H003F56B5,&HCF000000,&H0040C883,&H00000000,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H953F56B5,&H36BF2F7D,&H95408A78,&H003F2F7D,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H953F56B5,&H363F2F7D,&H95408A78,&H003F2F7D,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H003F56B5,&HCF000000,&H0040C883,&H00000000,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H003F56B5,&H36000000,&H66408A78,&H003F782E,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H663F56B5,&H363F782E,&H00408A78,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H003EB1DE,&HCF000000,&H0040C883,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H953EB1DE,&H363F2F7D,&H95408A78,&H003F2F7D,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H953EB1DE,&H36BF2F7D,&H95408A78,&H00BF2F7D,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&HCF000000,&H0040C883,&H00000000,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H95BF56B5,&H363F2F7D,&H95408A78,&H00BF2F7D,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&HCF000000,&H0040C883,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H66BEB1DE,&H363F782E,&H00408A78,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H95000000,&H363F2F7D,&H95408A78,&H00BF2F7D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H66000000,&H363F782E,&H00408A78,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H66000000,&H363F782E,&H00408A78,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H95000000,&H363F2F7D,&H95408A78,&H003F2F7D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H95000000,&H363F2F7D,&H95408A78,&H003F2F7D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H36000000,&H66408A78,&H003F782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H36000000,&H66408A78,&H003F782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H95000000,&H36BF2F7D,&H95408A78,&H003F2F7D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H95000000,&H36BF2F7D,&H95408A78,&H003F2F7D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H66000000,&H36BF782E,&H00408A78,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H36000000,&H66408A78,&H00BF782E,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H66000000,&H36BF782E,&H00408A78,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H95000000,&H36BF2F7D,&H95408A78,&H00BF2F7D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H05000000,&H29BFC353,&H00402308,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&H95000000,&H0040B32D,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H75BEB1DE,&H29BF8A1D,&H75402308,&H00BF8A1D,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&H29000000,&H05402308,&H00BFC353,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&H95000000,&H0040B32D,&H00000000,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H75BF56B5,&H293F8A1D,&H75402308,&H00BF8A1D,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H75BF56B5,&H29BF8A1D,&H75402308,&H003F8A1D,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H003EB1DE,&H95000000,&H0040B32D,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H053EB1DE,&H29BFC353,&H00402308,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H003EB1DE,&H29000000,&H05402308,&H003FC353,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H003F56B5,&H95000000,&H0040B32D,&H00000000,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H753F56B5,&H29BF8A1D,&H75402308,&H003F8A1D,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H753F56B5,&H293F8A1D,&H75402308,&H003F8A1D,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H003F56B5,&H95000000,&H0040B32D,&H00000000,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H003F56B5,&H29000000,&H05402308,&H003FC353,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H053F56B5,&H293FC353,&H00402308,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H003EB1DE,&H95000000,&H0040B32D,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H753EB1DE,&H293F8A1D,&H75402308,&H003F8A1D,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H753EB1DE,&H29BF8A1D,&H75402308,&H00BF8A1D,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&H95000000,&H0040B32D,&H00000000,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&H29000000,&H05402308,&H00BFC353,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H75BF56B5,&H293F8A1D,&H75402308,&H00BF8A1D,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&H95000000,&H0040B32D,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H05BEB1DE,&H293FC353,&H00402308,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&H29000000,&H05402308,&H00BFC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H75000000,&H293F8A1D,&H75402308,&H00BF8A1D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H05000000,&H293FC353,&H00402308,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H29000000,&H05402308,&H00BFC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H05000000,&H293FC353,&H00402308,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H75000000,&H293F8A1D,&H75402308,&H003F8A1D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H29000000,&H05402308,&H00BFC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H75000000,&H293F8A1D,&H75402308,&H003F8A1D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H29000000,&H05402308,&H003FC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H29000000,&H05402308,&H00BFC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H29000000,&H05402308,&H003FC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H75000000,&H29BF8A1D,&H75402308,&H003F8A1D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H29000000,&H05402308,&H00BFC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H75000000,&H29BF8A1D,&H75402308,&H003F8A1D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H05000000,&H29BFC353,&H00402308,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H29000000,&H05402308,&H00BFC353,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H05000000,&H29BFC353,&H00402308,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H75000000,&H29BF8A1D,&H75402308,&H00BF8A1D,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H38000000,&HEBC00587,&H003F27FC,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&HD5000000,&H00409A86,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H5EBEB1DE,&HEBBFBCD6,&H5E3F27FC,&H00BFBCD6,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&HD5000000,&H00409A86,&H00000000,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H5EBF56B5,&HEB3FBCD6,&H5E3F27FC,&H00BFBCD6,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H5EBF56B5,&HEBBFBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H003EB1DE,&HD5000000,&H00409A86,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H383EB1DE,&HEBC00587,&H003F27FC,&H00000000,&H00000000,&H0B000000,&H99BF56B5
    DATA &H6A3ED6BB,&H003EB1DE,&HEB000000,&H383F27FC,&H00400587,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H003F56B5,&HD5000000,&H00409A86,&H00000000,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H5E3F56B5,&HEBBFBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H5E3F56B5,&HEB3FBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H003F56B5,&HD5000000,&H00409A86,&H00000000,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H003F56B5,&HEB000000,&H383F27FC,&H00400587,&H00000000,&H6A000000,&H993EB1DE
    DATA &H0B3ED6BB,&H383F56B5,&HEB400587,&H003F27FC,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H003EB1DE,&HD5000000,&H00409A86,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H5E3EB1DE,&HEB3FBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H5E3EB1DE,&HEBBFBCD6,&H5E3F27FC,&H00BFBCD6,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&HD5000000,&H00409A86,&H00000000,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H00BF56B5,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H6A000000,&H99BEB1DE
    DATA &H0B3ED6BB,&H5EBF56B5,&HEB3FBCD6,&H5E3F27FC,&H00BFBCD6,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&HD5000000,&H00409A86,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H38BEB1DE,&HEB400587,&H003F27FC,&H00000000,&H00000000,&H0B000000,&H993F56B5
    DATA &H6A3ED6BB,&H00BEB1DE,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H5E000000,&HEB3FBCD6,&H5E3F27FC,&H00BFBCD6,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H38000000,&HEB400587,&H003F27FC,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H38000000,&HEB400587,&H003F27FC,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H5E000000,&HEB3FBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H5E000000,&HEB3FBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&HEB000000,&H383F27FC,&H00400587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&HEB000000,&H383F27FC,&H00400587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H5E000000,&HEBBFBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H5E000000,&HEBBFBCD6,&H5E3F27FC,&H003FBCD6,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H38000000,&HEBC00587,&H003F27FC,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&HEB000000,&H383F27FC,&H00C00587,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H38000000,&HEBC00587,&H003F27FC,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H5E000000,&HEBBFBCD6,&H5E3F27FC,&H00BFBCD6,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&H00BF6C84,&H00000000,&H3D3F8000,&H00BF2161,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&HBDBF6C84,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&H00BF6C84,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&HBDBF6C84,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&HBDBF6C84,&H003EE439,&HBDBF8000,&H00BEE439,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&HBDBF6C84,&H003EE439,&HBDBF8000,&H00BEE439,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&HBDBEC3F1,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&H3DBEC3F1,&H003F2161,&H003F8000,&H00000000,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&HBDBEC3F1,&H003EE439,&HBDBF8000,&H00BEE439,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&H3DBEC3F1,&H003F2161,&H003F8000,&H00000000,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&H3DBEC3F1,&H003F2161,&H00BF8000,&H00000000,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&H3DBEC3F1,&H003F2161,&H00BF8000,&H00000000,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&H3D3EC3F1,&H003F2161,&H003F8000,&H00000000,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&HBD3EC3F1,&H003EE439,&HBD3F8000,&H003EE439,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&H3D3EC3F1,&H003F2161,&H00BF8000,&H00000000,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&HBD3EC3F1,&H003EE439,&HBD3F8000,&H003EE439,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&HBD3EC3F1,&H003EE439,&HBDBF8000,&H003EE439,&H00000000,&HB6000000,&H003F6C84
    DATA &H41000000,&HBD3EC3F1,&H003EE439,&HBDBF8000,&H003EE439,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&HBD3F6C84,&H003EE439,&HBD3F8000,&H003EE439,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&H003F6C84,&H00000000,&H3D3F8000,&H003F2161,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&HBD3F6C84,&H003EE439,&HBDBF8000,&H003EE439,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&H003F6C84,&H00000000,&H3D3F8000,&H003F2161,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&H003F6C84,&H00000000,&H3DBF8000,&H003F2161,&H00000000,&H41000000,&H003EC3F1
    DATA &HB6000000,&H003F6C84,&H00000000,&H3DBF8000,&H003F2161,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&H003F6C84,&H00000000,&H3D3F8000,&H003F2161,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&HBD3F6C84,&H00BEE439,&HBD3F8000,&H003EE439,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&H003F6C84,&H00000000,&H3DBF8000,&H003F2161,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&HBD3F6C84,&H00BEE439,&HBD3F8000,&H003EE439,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&HBD3F6C84,&H00BEE439,&HBDBF8000,&H003EE439,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&HBD3F6C84,&H00BEE439,&HBDBF8000,&H003EE439,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&HBD3EC3F1,&H00BEE439,&HBD3F8000,&H003EE439,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&H3D3EC3F1,&H00BF2161,&H003F8000,&H00000000,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&HBD3EC3F1,&H00BEE439,&HBDBF8000,&H003EE439,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&H3D3EC3F1,&H00BF2161,&H003F8000,&H00000000,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&H3D3EC3F1,&H00BF2161,&H00BF8000,&H00000000,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&HBD3EC3F1,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&H00000000,&H00000000,&H3D3F8000,&H00BF2161,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H00BEE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H00BEE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&H3D000000,&H00BF2161,&H003F8000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&H3D000000,&H00BF2161,&H003F8000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H00BEE439,&HBD3F8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H00BEE439,&HBD3F8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&H00000000,&H00000000,&H3D3F8000,&H003F2161,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&H00000000,&H00000000,&H3D3F8000,&H003F2161,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H003EE439,&HBD3F8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H003EE439,&HBD3F8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H003EE439,&HBD3F8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&H3D000000,&H003F2161,&H003F8000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H003F8000,&HBD000000,&H00BEE439,&HBDBF8000,&H00BEE439,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&HBDBF6C84,&H00BEE439,&HBD3F8000,&H00BEE439,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&H00BF6C84,&H00000000,&H3D3F8000,&H00BF2161,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&HBDBF6C84,&H00BEE439,&HBDBF8000,&H00BEE439,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&H00BF6C84,&H00000000,&H3D3F8000,&H00BF2161,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&H00BF6C84,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H41000000,&H00BEC3F1
    DATA &HB6000000,&H3DBF6C84,&H00BF2161,&H00BF8000,&H00000000,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&H3DBEC3F1,&H00BF2161,&H003F8000,&H00000000,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&HBDBEC3F1,&H00BEE439,&HBD3F8000,&H00BEE439,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&H3DBEC3F1,&H00BF2161,&H00BF8000,&H00000000,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&HBDBEC3F1,&H00BEE439,&HBD3F8000,&H00BEE439,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&HBDBEC3F1,&H00BEE439,&HBDBF8000,&H00BEE439,&H00000000,&HB6000000,&H00BF6C84
    DATA &H41000000,&H00BEC3F1,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&HBD000000,&H003EE439,&HBDBF8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H3D000000,&H003F2161,&H00BF8000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H3D000000,&H003F2161,&H00BF8000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&HBD000000,&H003EE439,&HBDBF8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&HBD000000,&H003EE439,&HBDBF8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H003F2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H003F2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&HBD000000,&H00BEE439,&HBDBF8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&HBD000000,&H00BEE439,&HBDBF8000,&H003EE439,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H3D000000,&H00BF2161,&H00BF8000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H3DBF8000,&H00BF2161,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H3D000000,&H00BF2161,&H00BF8000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&HBD000000,&H00BEE439,&HBDBF8000,&H00BEE439,&H00000000,&H00000000,&H00000000
    DATA &H00BF8000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000,&H00000000
    DATA &H00,&H00,&H00,&H00,&H00,&H00,&H00
END FUNCTION

PS: All the programs in this thread were amazing... I enjoyed each of them!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: johnno56 on December 23, 2020, 04:58:45 pm

Very nicely done!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 23, 2020, 05:30:58 pm

Another gift from the GL master! Nice one @Ashish :)

You know I was kinda expecting something like this from Fellippe:

Code: QB64: [Select]

OPTION _EXPLICIT ' bplus mod of Fellippe's Pendula 2020-12-23
 
SCREEN _NEWIMAGE(1000, 600, 32)
_DELAY .25
_SCREENMOVE _MIDDLE
 
CONST maxPendulum = 15
DIM SHARED f&
f& = _LOADFONT("Arial.ttf", 20, "MONOSPACE")
_FONT f&
DIM g, i AS INTEGER
DIM theta(maxPendulum), accel(maxPendulum), speed(maxPendulum)
DIM length(maxPendulum), mass(maxPendulum)
DIM px, py, bx, by, rr, btx, bty, btx2, bty2
 
DIM a, x1, y1, x2, y2, x3, y3, x4, y4 'try one more time for ornament tops
 
g = 9.81
FOR i = 0 TO maxPendulum
    theta(i) = _PI / 1.5
    speed(i) = 0
    length(i) = 100 + i * 30
    mass(i) = 1 - i * .01
NEXT
 
px = _WIDTH / 2
py = -5
 
DO UNTIL _SCREENEXISTS: _LIMIT 1: LOOP
_TITLE "Pendula by FellippeHeitor with alittle mod by bplus"
COLOR , &H000000
DO
    CLS
    WHILE _MOUSEINPUT: WEND
    FOR i = maxPendulum TO 1 STEP -1 'reverse som lines aren't drawn over previous ones
        accel(i) = mass(i) * g * SIN(theta(i)) / 100
        speed(i) = speed(i) + accel(i) / 100
        theta(i) = theta(i) + speed(i)
        bx = px + length(i) * SIN(theta(i))
        btx = px + (length(i) - 30) * SIN(theta(i))
        btx2 = px + (length(i) - 32) * SIN(theta(i))
        by = py - length(i) * COS(theta(i))
        bty = py - (length(i) - 30) * COS(theta(i))
        bty2 = py - (length(i) - 32) * COS(theta(i))
        LINE (px, py)-(bx, by), &HAAFF8800
        FOR rr = 25 TO 0 STEP -.25
            IF i MOD 2 THEN CIRCLE (bx, by), rr, _RGB32(255 - rr * 7, 0, 0) ELSE CIRCLE (bx, by), rr, _RGB32(0, 255 - rr * 7, 0)
        NEXT
        CIRCLE (btx2, bty2), 3, &HFFFF8800
        a = _ATAN2(py - by, px - bx) - _PI / 2
        x1 = btx + 5 * COS(a): y1 = bty + 5 * SIN(a)
        x2 = btx + 5 * COS(a + _PI): y2 = bty + 5 * SIN(a + _PI)
        x3 = x1 + 7 * COS(a - _PI / 2): y3 = y1 + 7 * SIN(a - _PI / 2)
        x4 = x2 + 7 * COS(a - _PI + _PI / 2): y4 = y2 + 7 * SIN(a - _PI + _PI / 2)
        IF i MOD 2 THEN
            ftri x1, y1, x2, y2, x3, y3, &HFF660000
            ftri x3, y3, x4, y4, x2, y2, &HFF660000
        ELSE
            ftri x1, y1, x2, y2, x3, y3, &HFF007700
            ftri x3, y3, x4, y4, x2, y2, &HFF007700
        END IF
        _PRINTSTRING (bx - 5, by - 9), MID$("Merry Christmas", i, 1)
    NEXT
    _DISPLAY
    _LIMIT 60
LOOP
 
 
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
 
 

;-))

I confess being stymied trying to give the pendula little ornament like tops, the trig system used here is backwards from everything I've ever done in Basic. I will try one more time because I think I was going wrong trying to use this system, stick to what I know and all that... :)

BTW I posted a translation of this at JB and was informed that mass should not be needed but might compensate for some other thing... I think STx said similar. But got Wows, anyway. So Cheers @FellippeHeitor :)

Update: Yeah! Got it fixed to how I wanted it, using regular trig system. Reposted code above 7:55 PM my time.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 23, 2020, 05:43:50 pm

Lol, I had a hard time remembering what pendulum code you were talking about until I ran it. Great mod!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 23, 2020, 07:40:27 pm

Thanks to everyone who submitted their code! Here's our annual Holiday Season Code Sampler video:

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Petr on December 24, 2020, 05:05:13 am

Nicely done, Fellippe. Merry Christmas!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dimster on December 24, 2020, 08:10:41 am

What a beautiful Christmas butterfly you QB64 coders have created. Thanks for same. Hope you all get a good poke in the arm in the New Year and have a Merry Christmas.

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 24, 2020, 11:13:49 am

Well I think it's way too short, most samplers let you at least taste the candy, not just smell it ;-))

But I blame Dav, his music track ran too short! Poor Fellippe had to jam everything into 2 minutes of sound track and a good job at that.

Next year I suggest a whole album from Dav so Fellippe can make a movie ;-))

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 24, 2020, 11:25:04 am

I did have to extend the original track though... Can you spot the patch?

Dav, don't spill it 😂

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: bplus on December 24, 2020, 11:35:31 am

Quote from: FellippeHeitor on December 24, 2020, 11:25:04 am

I did have to extend the original track though... Can you spot the patch?

Dav, don't spill it 😂

Um... once the work is finished, probably not a good idea to point out the bugs.

My brother the perfectionist does that often and danged if those hidden bugs don't look 1000 x's bigger than they were before he pointed them out!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: FellippeHeitor on December 24, 2020, 11:50:03 am

😂

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Pete on December 26, 2020, 01:29:04 am

Code: QB64: [Select]

beta% = 1 ' Testing text
debug% = 0 ' Debugger stats.
scrb.opt = 0 ' Variable size scrollbar box.
 
DIM scrn AS my_scrn
DIM page AS my_page
DIM margin AS my_margin
DIM scrb AS my_scrb
DIM cursor AS my_cursor
DIM mb AS my_mb
 
DIM noe AS INTEGER
DIM row AS INTEGER
DIM scr AS INTEGER
 
TYPE my_scrn
    w AS INTEGER
    h AS INTEGER
END TYPE
 
TYPE my_page
    w AS INTEGER
    h AS INTEGER
    c AS INTEGER
END TYPE
 
TYPE my_margin
    t AS INTEGER
    b AS INTEGER
    l AS INTEGER
    r AS INTEGER
END TYPE
 
TYPE my_scrb
    t AS INTEGER
    b AS INTEGER
    l AS INTEGER
    x AS INTEGER
    i AS INTEGER
    d AS INTEGER
    h AS INTEGER
    s AS INTEGER
    opt AS INTEGER
    adjust AS INTEGER
END TYPE
 
TYPE my_cursor
    find AS INTEGER
    scbrrow AS INTEGER ' row + scr
    scbrcol AS INTEGER ' POS(0)
    holdscr AS INTEGER ' Holds scr
    holdrow AS INTEGER ' Holds row
    holdscrbx AS INTEGER ' Holds scrb.x
    top AS INTEGER
    bot AS INTEGER
END TYPE
 
TYPE my_mb
    l AS INTEGER
    r AS INTEGER
    m AS INTEGER
    w AS INTEGER
    drag AS INTEGER
    dragon AS INTEGER
END TYPE
 
GOSUB setvariables
 
GOSUB getvar_setscrn
 
IF beta% THEN GOSUB betatestfile
 
DO
    GOSUB getkey
 
    IF updatescrn% THEN
 
        GOSUB keyeffect
 
        GOSUB determinewrap
 
        IF wrap.on% THEN GOSUB wrapper
 
        GOSUB displaydoc
 
        updatescrn% = 0
    END IF
 
LOOP
END
 
' **************************** GOSUB ROUTINES *******************************
 
setvariables:
scrn.h = 25
margin.t = 3
margin.b = 3
margin.l = 5
margin.r = 5
border.thk = 0
border.stl = 1
ins% = 7
ovm% = 1 ' Change this to 0 for no over margin cursoring. 0 needed if right margin is at edge of screen.
scrn.w = 80
scrn.h = 25
dwidth = scrn.w - (margin.l + margin.r): dwidth2 = dwidth + 2
page.h = scrn.h - (margin.t + margin.b + CINT(border.thk / border.stl + .01))
page.w = scrn.w - (margin.l + margin.r + border.thk * 2)
REDIM x$(page.h)
c1% = 7: c2% = 0: h1% = 15: h2% = 1 ' Normal text and highlighted text colors.
RETURN ' ==================================================================
 
betatestfile:
SELECT CASE beta%
    CASE 1
        REDIM x$(10)
        a$ = "Money's Short" + CHR$(255) + CHR$(255) + "Times Are Crap" + CHR$(255) + CHR$(255) + "Here's Your Flocking" + CHR$(255) + CHR$(255) + "Christmas App"
    CASE 2
        OPEN "mybetatest.txt" FOR BINARY AS #1
        a$ = SPACE$(LOF(1))
        GET #1, , a$
        CLOSE #1
        i% = (LEN(a$) / dwidth) * 2
        REDIM x$(i%)
        DO UNTIL INSTR(a$, CHR$(13) + CHR$(10)) = 0
            a$ = MID$(a$, 1, INSTR(a$, CHR$(13) + CHR$(10)) - 1) + CHR$(255) + MID$(a$, INSTR(a$, CHR$(13) + CHR$(10)) + 2)
        LOOP
END SELECT
 
wrap.on% = -1: GOSUB wrapper
filled% = page.h: row = 1
LOCATE margin.t + row, margin.l + 1
GOSUB displaydoc
GOSUB movescrollbox
RETURN ' ==================================================================
 
keyeffect:
IF a$ = "" THEN
    x$(row + scr) = "" + CHR$(10): wrap.on% = -1
ELSE
    x$(row + scr) = a$ + CHR$(10)
END IF
 
aux$ = a$
 
IF INSTR(aux$, CHR$(4)) AND cur$ = CHR$(32) THEN
    MID$(aux$, INSTR(aux$, CHR$(4)), 1) = cur$
END IF
 
RETURN ' ==================================================================
 
determinewrap:
IF row > 1 OR scr > 0 THEN ' Wrap to line above analysis. Determine if the line above the text input line should wrap up the first word of the text input.
    l0% = dwidth - (INSTR(x$(row - 2 + scr + 1), CHR$(10)) - 1) ' -1 chops off chr$(10)
    l1% = INSTR(aux$ + CHR$(32), CHR$(32)) - 1
    IF l0% >= l1% AND l1% > 0 OR LEFT$(aux$, 1) = CHR$(32) AND l0% >= 0 THEN ' The line above has enough room to wrap up the first word of the current text line.
        x$(row + scr) = a$ + CHR$(10) ' The current line array is changed to the current line of text input.
        a$ = MID$(x$(row - 1 + scr), 1, INSTR(x$(row - 1 + scr), CHR$(10)) - 1) ' The current line of text input is now the line above.
        IF row = 1 THEN
            scr = scr - 1: GOSUB scrollscrn
        ELSE
            row = row - 1
        END IF
        wrap.on% = -1
        RETURN
    END IF
END IF
 
IF RIGHT$(aux$, 1) <> CHR$(32) AND row + scr < noe OR INSTR(aux$, CHR$(255)) THEN ' Delete last space of a text line, except the last line. Current line below will wrap to line below.
    wrap.on% = -1
ELSE
    xcurrent$ = aux$
    xcurrent% = dwidth - LEN(xcurrent$)
 
    IF row + scr + 1 > UBOUND(x$) THEN
        xbelow$ = "" ' Text line below is blank, but the line above may be too long and still needs to be wrapped down.
    ELSE
        xbelow$ = MID$(x$(row + 1 + scr), 1, LEN(x$(row + 1 + scr)) - 1)
    END IF
 
    IF LEFT$(xbelow$, 1) = CHR$(32) THEN
        xbelow% = 1 ' Leading space.
    ELSE
        xbelow% = INSTR(xbelow$ + CHR$(32), CHR$(32)) - 1
    END IF
 
    IF xcurrent% >= xbelow% AND xbelow% > 0 OR xcurrent% < 0 THEN
        wrap.on% = -1
    END IF
END IF
 
RETURN ' ==================================================================
 
wrapper:
start% = 1: ii% = 0: filled% = 0 ' Do not exit this routine without zeroing wrap.on%.
acut$ = a$ + acut$: a$ = ""
 
DO
    ' Continue to concatenate until full text line or greater is achieved or until end of doc.
    DO UNTIL ii% >= noe - (row + scr) ' > is a precaution. I had one error where if failed to exit loop with = alone.
        acut$ = acut$ + MID$(x$(row + scr + ii% + 1), 1, INSTR(x$(row + scr + ii% + 1), CHR$(10)) - 1) ' Cut off chr$(10).
        x$(row + scr + ii% + 1) = ""
        ii% = ii% + 1
        IF LEN(acut$) > dwidth THEN EXIT DO
    LOOP
 
    '==========================================================================================
 
    ' Cut text line and place into next text array. -------------------------------------------
 
    h% = INSTR(MID$(acut$, 1, dwidth + 1), CHR$(4))
    IF h% THEN
        IF cur$ = CHR$(32) OR cur$ = CHR$(255) THEN
            MID$(acut$, h%, 1) = cur$
        END IF
    END IF
 
    IF INSTR(MID$(acut$, 1, dwidth + 1), CHR$(255)) THEN
        x$ = MID$(acut$, 1, INSTR(acut$, CHR$(255)))
        start% = start% + INSTR(acut$, CHR$(255))
    ELSEIF RIGHT$(MID$(acut$, start%, dwidth + 1), 1) = CHR$(32) THEN
        x$ = MID$(acut$, start%, dwidth + 1)
        start% = start% + dwidth + 1
    ELSEIF INSTR(MID$(acut$, start%, dwidth) + CHR$(32), CHR$(32)) > dwidth THEN
        x$ = MID$(acut$, 1, dwidth)
        start% = start% + dwidth
    ELSE
        IF LEN(acut$) > dwidth THEN
            k% = _INSTRREV(MID$(acut$, 1, dwidth), CHR$(32)) ' Include the space so word following is left justified on current line when word proceeding wraps to top line.
            x$ = MID$(acut$, 1, k%)
            start% = start% + k%
        ELSE
            k% = LEN(acut$)
            x$ = MID$(acut$, 1, k%)
            start% = start% + k%
        END IF
    END IF
 
    IF h% THEN
        IF cur$ = CHR$(32) OR cur$ = CHR$(255) THEN
            MID$(x$, h%, 1) = CHR$(4)
        END IF
    END IF
 
    filled% = filled% + 1
 
    IF LEN(x$) THEN
        j% = row - 1 + scr + filled%
        IF j% > UBOUND(x$) THEN REDIM _PRESERVE x$(j%)
        x$(j%) = x$ + CHR$(10)
    END IF
 
    acut$ = MID$(acut$, start%)
    start% = 1
LOOP UNTIL ii% >= noe - (row + scr) AND acut$ = ""
 
' Determine end of doc line.
 
IF row + scr + filled% - 1 > noe THEN
    noe = filled% + row + scr - 1
ELSE
    FOR i% = noe TO 1 STEP -1
        IF LEN(x$(i%)) AND LEFT$(x$(i%), 1) <> CHR$(10) THEN noe = i%: EXIT FOR
    NEXT
END IF
 
x$(0) = "" ' Precaution.
DO
    IF LEFT$(x$(noe), 1) = CHR$(10) THEN x$(noe) = ""
    IF x$(noe) = "" AND noe > 1 THEN noe = noe - 1 ELSE EXIT DO
LOOP
 
q% = 1 ' Display begins 1 line above row to handle any wrap changes.
wrap.on% = 0
RETURN ' ==================================================================
 
displaydoc:
' Routine to display doc arrays to page.
 
IF noe >= UBOUND(x$) THEN REDIM _PRESERVE x$(noe + 1)
IF UBOUND(x$) > noe + 1 THEN REDIM _PRESERVE x$(noe + 1)
 
j% = UBOUND(x$)
FOR i% = j% TO 1 STEP -1
    IF INSTR(x$(i%), CHR$(10)) = 1 THEN
        x$(i%) = ""
    ELSE
        IF INSTR(x$(i%), CHR$(10)) > 1 THEN EXIT FOR
    END IF
NEXT
 
gg% = 0
FOR g% = 1 TO noe
    IF INSTR(x$(g%), CHR$(4)) THEN gg% = g%: EXIT FOR
NEXT
 
IF gg% > scr + row AND row + scr < noe AND row = page.h THEN
    scr = scr + 1: GOSUB scrollscrn: row = row - 1: LOCATE margin.t + row, POS(0)
END IF
 
yy% = CSRLIN: xx% = POS(0)
 
IF row = 1 OR wrap.on% = 0 THEN q% = 0 ' Disable print line above.
 
k% = filled% + q% ' Number of altered lines to print to screen. If q% = 1 the line above the current row is also printed. Note that since the FOR loop starts at j% = 0, k% is actually one less than the number of lines altered in the wrap routine.
IF row - q% + k% >= page.h THEN k% = page.h - (row - q%)
IF scr + row - q% + k% > UBOUND(x$) THEN k% = UBOUND(x$) - (scr + row - q%)
 
IF noe - scr < page.h AND noe >= page.h THEN ' Adjust to bottom of the text screen.
    scr = noe - page.h
    IF noe - scr = page.h AND LEN(MID$(x$(noe), 1, INSTR(x$(noe), CHR$(10)) - 1)) >= dwidth OR noe - scr = page.h AND INSTR(x$(noe), CHR$(255)) THEN
        scr = scr + 1 ' Raises everything up one line below bottom line to allow for the blank line occupied by the cursor at column 1.
        IF POS(0) = margin.l + 1 AND row = page.h - 1 AND INSTR(x$(row + scr), CHR$(255)) THEN yy% = yy% + 1
    ELSE
        yy% = yy% + 1
    END IF
    row = 1: k% = page.h - 1: q% = 0
END IF
 
FOR j% = 0 TO k%
    i% = row - q% + j% ' Display row.
    LOCATE i% + margin.t, margin.l + 1
    a1$ = SPACE$(dwidth + 1)
    x$ = RTRIM$(MID$(x$(scr + i%), 1, INSTR(x$(scr + i%), CHR$(10)) - 1))
    MID$(a1$, 1, LEN(MID$(x$(scr + i%), 1, dwidth))) = x$
 
    h% = INSTR(x$, CHR$(4))
    IF h% THEN ' Re-establish cursor position.
        yy% = CSRLIN: xx% = margin.l + border.thk + h%
        MID$(a1$, h%, 1) = cur$ ' NOTE: h% can be longer than len(a1$) when # is a space at end of full line of text. When this happens, QB64 will simply not include it in the shaorter a1$.
        MID$(x$(scr + i%), h%, 1) = cur$: cur$ = ""
    END IF
 
    PRINT a1$;
NEXT
 
q% = 0
LOCATE yy%, xx%
 
row = CSRLIN - margin.t ' Needed here and in getkey for auto events.
 
'----------------------------------------------------------------------------------------------------------------------------
REM BKSP CHR$(8) used at end of doc requires this routine to re-position cursor at the end of a wrapped upwards piece of text.
IF cur$ = "eod" THEN
    b$ = CHR$(0) + "u": GOSUB getkeyauto: cur$ = ""
END IF
'----------------------------------------------------------------------------------------------------------------------------
 
IF curadvance% THEN
    SELECT CASE curadvance%
        CASE 1
            b$ = CHR$(0) + ">"
        CASE -1
            ' Paragraph. variable is set to -1 for paragraphs.
            b$ = CHR$(0) + "^"
    END SELECT
 
    GOSUB getkeyauto ' Make sure this routine always exits getkeyauto so it can return here after advancing cursor. Remember, non character keys don't exit that loop unless b$ = "". There is a kloop% condition to meet this gosub/return requirement.
 
    curadvance% = 0
END IF
 
GOSUB makescrb
RETURN ' ==================================================================
 
' -------------------------------------------------------------------------
'                             NESTED GOSUBS
' -------------------------------------------------------------------------
 
markercalc:
IF hlbypass% = 0 THEN
    o% = (row - 1) * dwidth2 + dwidth + 1
ELSE
    hlbypass% = 0
END IF
 
o1% = (o% - (o% MOD dwidth2)) / dwidth2 + 1 ' Relative (margin independent) cursor row origin.
d% = (row - 1) * dwidth2 + col ' Relative (margin independent) cursor destination marker.
o2% = o% MOD dwidth2 ' Relative (margin independent) cursor column origin.
d1% = row ' Relative (margin independent) cursor row destination. Note: row is also relative (margin independent).
d2% = col ' Relative (margin independent) cursor column destination. Note: col is also relative (margin independent).
RETURN
 
scrollscrn: '
yy% = CSRLIN: xx% = POS(0)
scrmov = scr - oldscr
 
IF mark% AND markbypass% = 0 THEN
    mark% = mark% - scrmov * dwidth2
    markrow% = markrow% - scrmov
    d% = (CSRLIN - margin.t - 1 - scrmov) * dwidth2 + POS(0) - margin.l
    IF mhl1% THEN
        mhl1% = mhl1% - scrmov * dwidth2
        mhl1row% = mhl1row% - scrmov
    END IF
 
    j% = d1% - scrmov
    IF cutdrow% > scr AND cutdrow% <= page.h + scr THEN ' On screen
        j% = cutdrow% - scr
        d% = (j% - 1) * dwidth2 + cutdcol%
    ELSE ' Off screen.
        IF cutdrow% < scr THEN ' Above screen.
            d% = 1
            mhl1row% = 0
        ELSE ' Below screen.
            a1$ = MID$(x$(page.h + scr), 1, INSTR(x$(page.h + scr), CHR$(10)) - 1)
            d% = (page.h - 1) * dwidth2 + LEN(a1$)
            IF LEN(a1$) > dwidth THEN dmodify% = 1 ELSE d% = d% + 1
        END IF
    END IF
    d1% = (d% - (d% MOD dwidth2)) / dwidth2 + 1
    d2% = d% MOD dwidth2 ' Relative (margin independent) cursor column origin.
    yy% = margin.t + d1%: xx% = margin.l + d2%
    row = d1%: col = d2%
    LOCATE yy%, xx%
    j% = 0
    IF cutmrow% THEN
        SELECT CASE cutmrow%
            CASE IS < cutdrow%: j% = cutmrow%: j1% = cutmcol%
            CASE IS = cutdrow% ' Highlighting begins and ends on same row. Ex: Left and right arrow keys.
                IF cutmcol% < cutdcol% THEN j% = cutmrow%: j1% = cutmcol% ELSE j% = cutdrow%: j1% = cutdcol% ' Right arrow vs left arrow directions.
            CASE IS > cutdrow%: j% = cutdrow%: j1% = cutdcol%
        END SELECT
 
        jtop% = cutmrow%: jbot% = cutdrow%: IF jtop% > jbot% THEN SWAP jtop%, jbot%
        IF h% < 0 THEN j% = -j% ' Preserve highlighted text while using scrollbar.
    END IF
ELSE
    j% = 0 ' For all non-mark% (highlighted) text line printing.
END IF
 
FOR i% = 1 TO page.h
    IF scr + i% > noe THEN EXIT FOR
    LOCATE margin.t + i%, margin.l + 1
    a1$ = SPACE$(dwidth + 1)
    MID$(a1$, 1) = MID$(x$(scr + i%), 1, INSTR(x$(scr + i%), CHR$(10)) - 1)
    a2$ = MID$(x$(scr + i%), 1, INSTR(x$(scr + i%), CHR$(10)) - 1)
    a3$ = SPACE$(dwidth + 1 - LEN(a2$))
    x1 = c1%: x2 = c2%: x3 = c1%: x4 = c2%: k% = LEN(a2$)
 
    SELECT CASE j%
        CASE 0
            PRINT a1$;
        CASE IS < 0
            IF i% + scr = jtop% THEN
                IF cutmrow% = cutdrow% THEN k% = ABS(cutmcol% - cutdcol%)
                x3 = h1%: x4 = h2%
            ELSEIF i% + scr > jtop% AND i% + scr < jbot% THEN
                j1% = 1: x3 = h1%: x4 = h2%
            ELSEIF i% + scr = jbot% THEN
                j1% = 1: x3 = h1%: x4 = h2%
                IF cutmrow% < cutdrow% THEN k% = col - 1 ELSE k% = cutmcol% - 1
            END IF
 
            COLOR x1, x2: PRINT MID$(a2$, 1, j1% - 1);
            COLOR x3, x4: PRINT MID$(a2$, j1%, k%);
            COLOR c1%, c2%: PRINT MID$(a2$, j1% + k%) + a3$;
        CASE ELSE
            IF i% = h% THEN
                IF cutmrow% = cutdrow% THEN ' Left/Right Highlighting on origination row.
                    x3 = h1%: x4 = h2%: k% = ABS(cutmcol% - cutdcol%)
                ELSE ' Left/Right/Up/Down Highlighting from row before scrolling row.
                    x3 = h1%: x4 = h2%
                    IF cutdrow% > cutmrow% THEN
                        j1% = 1: k% = col - 1
                    ELSE
                        ' Do nothing. Arrow left and up do not require any change in parameters here.
                    END IF
                END IF
            ELSE
                IF i% + scr > jtop% AND i% + scr < jbot% THEN
                    j1% = 1: x3 = h1%: x4 = h2%
                ELSE
                    IF i% + scr = cutmrow% THEN
                        x3 = h1%: x4 = h2%
                        IF cutdrow% < cutmrow% THEN
                            j1% = 1: k% = cutmcol% - 1
                        ELSEIF cutdrow% = cutmrow% THEN
                            k% = ABS(cutmcol% - cutdcol%)
                        ELSEIF cutdrow% > cutmrow% THEN
                            ' Do nothing.
                        END IF
                    ELSEIF i% + scr = cutdrow% THEN
                        x3 = h1%: x4 = h2%
                        IF cutdrow% > cutmrow% THEN
                            j1% = 1: k% = cutdcol% - 1
                        ELSE
                            k% = ABS(LEN(a2$) - cutdcol%)
                        END IF
                    END IF
                END IF
            END IF
            COLOR x1, x2: PRINT MID$(a2$, 1, j1% - 1);
            COLOR x3, x4: PRINT MID$(a2$, j1%, k%);
            COLOR c1%, c2%: PRINT MID$(a2$, j1% + k%, LEN(a2$) - k%) + a3$;
    END SELECT
NEXT
oldscr = scr
COLOR c1%, c2%
LOCATE yy%, xx%
 
GOSUB movescrollbox
 
RETURN
 
wipescrn:
yy% = CSRLIN: xx% = POS(0)
a1$ = SPACE$(dwidth + 1)
FOR i% = 1 TO page.h
    LOCATE i% + margin.t, margin.l + 1
    PRINT a1$;
NEXT
LOCATE yy%, xx%
RETURN
 
hlwipescrn:
yy% = CSRLIN: xx% = POS(0)
FOR j% = 1 TO page.h
    IF j% + scr > noe THEN EXIT FOR
    x$ = SPACE$(dwidth + 1)
    a1$ = x$(j% + scr)
    MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
    LOCATE margin.t + j%, margin.l + 1
    PRINT x$;
NEXT
GOSUB clearmarkers
LOCATE yy%, xx%
RETURN
 
clearmarkers:
' Clear most variables used in highlighting process. Some others are non-essential to conditions.
mark% = 0: o% = 0: mhl% = 0: mhl1% = 0: mhl1col% = 0: mhl1row% = 0: mhlclear% = 0: cutdrow% = 0
cutmrow% = 0: o1% = 0: o2% = 0: d% = 0: d1% = 0: d2% = 0: dmodify% = 0
markrow% = 0: markcol% = 0: cutmcol% = 0: cutdcol% = 0
RETURN
 
betatest:
ss% = CSRLIN: ww% = POS(0)
z$ = MID$(beta$, 1, INSTR(beta$, "|") - 1)
beta$ = MID$(beta$, INSTR(beta$, "|") + 1)
IF LEFT$(z$, 1) = CHR$(32) THEN
    b$ = CHR$(0) + CHR$(VAL(MID$(z$, 2)))
ELSE
    b$ = CHR$(VAL(z$))
END IF
IF LEN(beta$) THEN
    LOCATE 24, 1: PRINT SPACE$(40);: LOCATE 24, 1
    COLOR 1, 0
    PRINT LEN(beta$) \ 2; VAL(z$);
    IF LEFT$(z$, 1) = CHR$(32) THEN PRINT " 0"; CHR$(VAL(MID$(z$, 2)));
    IF ASC(b$) > 31 THEN PRINT " b$ = "; b$;
    LOCATE ss%, ww%
    COLOR 7, 0
END IF
RETURN
 
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'                          LARGEST GOSUB ROUTINE
getkey:
DO
    _LIMIT 30
    IF debug% THEN GOSUB debugger
 
    DEF SEG = 0 ' Look for Shift key press.
    IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN shift% = -1 ELSE shift% = 0
    IF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN ctrl% = -1 ELSE ctrl% = 0
    IF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN ctrlshift% = -1 ELSE ctrlshift% = 0
    DEF SEG
 
    ' Mouse clicks can influence b$ outside of the keypress loop. That's why b$ = "" in some keypress routines when they are completed.
    IF autokey% = 0 THEN
        b$ = INKEY$
        IF LEN(b$) THEN
            IF curhide% = -1 THEN
                GOSUB backtocursor
            ELSE
                GOSUB getcurinfo
            END IF
            locked% = 0 ' A key press removes all mouse and mouse wheel locks.
            IF ctrlshift% THEN IF b$ = CHR$(0) + "s" OR b$ = CHR$(0) + "t" THEN shift% = -1
        END IF
    ELSE
        autokey% = 0
        IF LEN(autokey$) THEN b$ = autokey$: autokey$ = ""
    END IF
 
    IF LEN(beta$) THEN GOSUB betatest
 
    IF mhl% THEN
        null$ = INKEY$: b$ = "" ' Clear key buffer when left mouse button is held down and lock out keys.
    END IF
 
    IF mark% THEN
        IF b$ >= CHR$(32) AND b$ <= CHR$(127) THEN
            autokey% = -99: autokey$ = b$
            b$ = CHR$(0) + "S"
        END IF
    END IF
 
    IF mark% AND b$ = CHR$(24) OR mark% AND b$ = CHR$(3) OR mark% AND b$ = CHR$(0) + "S" OR b$ = CHR$(1) OR b$ = CHR$(22) OR ctrlshift% AND b$ = CHR$(0) + "u" OR ctrlshift% AND b$ = CHR$(0) + "w" THEN ' Cut/Copy/Paste
 
        SELECT CASE b$
            CASE CHR$(0) + "w" ' Ctrl + Shift + Home
                ' Required hold variables.
                hold1% = row: hold2% = scr: hold3% = POS(0) - margin.l
 
                IF mark% THEN
                    markbypass% = -1: GOSUB getkeyauto: markbypass% = 0
 
                    IF cutmrow% < cutdrow% THEN
                        j% = cutmrow% - scr: k% = cutdrow% - scr: IF k% > page.h THEN k% = page.h
                        FOR i% = j% TO k%
                            x$ = SPACE$(dwidth + 1)
                            a1$ = x$(i% + scr)
                            MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
                            LOCATE margin.t + i%, margin.l + 1
                            PRINT x$;
                        NEXT
                        mark% = (cutmrow% - 1) * dwidth2 + cutmcol% - 1 ' Note the -1 is here to "flip" to the other side of the highlighted line and not overlap.
                        markrow% = (mark% - (mark% MOD dwidth2)) / dwidth2 + 1
                        markcol% = mark% MOD dwidth2
                    ELSE
                        mark% = (cutmrow% - 1) * dwidth2 + cutmcol%
                        markrow% = cutmrow%: markcol% = cutmcol% - 1 ' - 1 required to avoid overlap.
                    END IF
 
                    IF mark% = 0 THEN ' Shift + Ctrl + Home resulted in clearing all text when all text was previously highlighted. Ex: Shift + Ctrl + A followed by Shift + Ctrl + HOme.
                        GOSUB clearmarkers
                    ELSE
                        cutdrow% = 1: cutdcol% = 1
                    END IF
 
                    col = 1 ' Required.
                    b$ = ""
                ELSE
                    GOSUB wipescrn
                    GOSUB clearmarkers
                    mark% = (hold1% + hold2% - 1) * dwidth2 + hold3%: markrow% = hold1% + hold2%: markcol% = hold3%
                    cutmrow% = hold1% + hold2%: cutmcol% = markcol%
                    cutdrow% = 1: cutdcol% = 1: col = 1
                END IF
 
                row = 1: scr = 0: LOCATE margin.t + row, margin.l + 1
 
                GOSUB markercalc
 
                j% = page.h: k% = 1: g% = 0: IF j% >= cutmrow% THEN j% = cutmrow%: g% = 1
                COLOR h1%, h2%
                FOR i% = 0 TO j% - 1 - g%
                    LOCATE margin.t + 1 + i%, margin.l + 1
                    PRINT MID$(x$(k% + i%), 1, INSTR(x$(k% + i%), CHR$(10)) - 1);
                NEXT
                IF g% THEN
                    LOCATE margin.t + 1 + i%, margin.l + 1
                    PRINT MID$(x$(k% + i%), 1, markcol%);
                    COLOR c1%, c2%
                    PRINT MID$(x$(k% + i%), markcol% + 1);
                END IF
                COLOR c1%, c2%
                LOCATE margin.t + 1, margin.l + 1
                b$ = ""
            CASE CHR$(0) + "u" ' Ctrl + Shift + End
                hold1% = row: hold2% = scr: hold3% = POS(0) - margin.l
                holdcutmrow% = cutmrow%: holdcutmcol% = cutmcol%: holdcutdrow% = cutdrow%: holdcutdcol% = cutdcol%
 
                IF mark% THEN
                    markbypass% = -1: GOSUB getkeyauto: markbypass% = 0
 
                    IF cutmrow% > cutdrow% THEN ' Highlighting was from bottom up.
                        hold1% = cutmrow% - scr: hold2% = scr: hold3% = cutmcol%
                    ELSE ' Highlighting continuing from top down.
                        mark% = (cutmrow% - 1) * dwidth2 + cutmcol%
                        markrow% = cutmrow%
                        cutdrow% = row + scr: cutdcol% = POS(0) - margin.l
                        hold1% = cutmrow% - hold2% ' orig scr. hold1% is now row.
                        hold3% = cutmcol%
                    END IF
                ELSE
                    GOSUB clearmarkers: GOSUB getkeyauto
                    mark% = (hold1% + hold2% - 1) * dwidth2 + hold3%: markrow% = hold1% + hold2%: markcol% = hold3%
                    cutmrow% = hold1% + hold2%: cutmcol% = markcol%
                    cutdrow% = noe: cutdcol% = LEN(MID$(x$(noe), 1, INSTR(x$(noe), CHR$(10)) - 1)) + 1
                END IF
 
                yy% = CSRLIN: xx% = POS(0): col = xx% - margin.l
 
                GOSUB markercalc
 
                COLOR h1%, h2%
 
                IF noe - cutmrow% < page.h THEN
                    j% = page.h - (cutmrow% - scr)
                    k% = cutmrow% - scr
                ELSE
                    j% = page.h - 1: k% = 1: hold1% = 1: hold2% = scr: hold3% = 1
                END IF
 
                IF noe < page.h THEN j% = noe - hold1%
                LOCATE margin.t + k%, margin.l + hold3%
                a1$ = MID$(x$(hold1% + hold2%), 1, INSTR(x$(hold1% + hold2%), CHR$(10)) - 1)
                PRINT MID$(a1$, hold3%);
                FOR i% = 1 TO j%
                    LOCATE margin.t + k% + i%, margin.l + 1
                    PRINT MID$(x$(hold1% + hold2% + i%), 1, INSTR(x$(hold1% + hold2% + i%), CHR$(10)) - 1);
                NEXT
                COLOR c1%, c2%
                LOCATE yy%, xx%
 
                IF mark% <> 0 AND hold1% = row AND cutmrow% = holdcutmrow% AND cutmcol% = holdcutmcol% AND cutdrow% = holdcutdrow% AND cutdcol% = holdcutdcol% THEN
                    GOSUB clearmarkers
                END IF
 
                b$ = ""
            CASE CHR$(1)
                GOSUB clearmarkers
                b$ = CHR$(0) + "u"
                GOSUB getkeyauto
                yy% = CSRLIN: xx% = POS(0)
                mark% = dwidth2 * -scr + 1: markrow% = -scr + 1: markcol% = 1
                cutmrow% = 1: cutmcol% = 1
                cutdrow% = noe: cutdcol% = LEN(MID$(x$(noe), 1, INSTR(x$(noe), CHR$(10)) - 1)) + 1
                col = xx% - margin.l
 
                GOSUB markercalc
 
                LOCATE margin.t + 1, margin.l + 1
                j% = page.h: k% = scr + 1
                IF noe < page.h THEN j% = noe
                COLOR h1%, h2%
                FOR i% = 0 TO j% - 1
                    LOCATE margin.t + 1 + i%, margin.l + 1
                    PRINT MID$(x$(k% + i%), 1, INSTR(x$(k% + i%), CHR$(10)) - 1);
                NEXT
                COLOR c1%, c2%
                LOCATE yy%, xx%
                b$ = ""
            CASE CHR$(0) + "S", CHR$(24) ' Del and Cut Ctrl + X
                IF b$ = CHR$(24) THEN GOSUB copytext
                IF cutmrow% = cutdrow% THEN ' Same line delete.
                    GOSUB singlelinedelete
                    updatescrn% = 1
                    b$ = "exit": EXIT DO
                ELSE ' Multiple line delete.
                    GOSUB multilinedelete
                    b$ = ""
                END IF
            CASE CHR$(3) ' Copy Ctrl + C
                GOSUB copytext
                b$ = "exit": EXIT DO
            CASE CHR$(22) ' Paste Ctrl + V
                ' NOTE: col is not defined in these wp routines but is when scrollscrn is called.
                GOSUB clipboardconvert
                IF row = 1 AND scr > 0 THEN
                    scr = scr - 1: h% = 0: GOSUB scrollscrn: row = row + 1
                    LOCATE margin.t + row, margin.l + col
                ELSEIF row = page.h AND scr + page.h < noe THEN
                    scr = scr + 1: h% = 0: GOSUB scrollscrn: row = row - 1
                    LOCATE margin.t + row, margin.l + col
                END IF
 
                IF mark% THEN
                    i1% = cutmrow%: j1% = cutmcol%
                    i2% = cutdrow%: j2% = cutdcol%
                    IF cutdrow% < cutmrow% OR cutdrow% = cutmrow% AND cutdcol% < cutmcol% THEN SWAP i1%, i2%: SWAP j1%, j2%
                ELSE
                    i1% = row + scr: j1% = POS(0) - margin.l
                    i2% = row + scr: j2% = POS(0) - margin.l
                END IF
                a1$ = MID$(x$(i1%), 1, INSTR(x$(i1%), CHR$(10)) - 1)
                a2$ = MID$(a1$, 1, j1% - 1)
                a1$ = MID$(x$(i2%), 1, INSTR(x$(i2%), CHR$(10)) - 1)
                a3$ = MID$(a1$, j2%)
                IF a3$ = "" THEN
                    cur$ = "eod"
                ELSE
                    cur$ = LEFT$(a3$, 1): MID$(a3$, 1, 1) = CHR$(4)
                END IF
                IF row > 1 THEN
                    row = row - 1
                    a1$ = MID$(x$(i1% - 1), 1, INSTR(x$(i1% - 1), CHR$(10)) - 1)
                    a$ = a1$ + a2$ + myCLIPBOARD$ + a3$
                ELSE
                    a$ = a2$ + myCLIPBOARD$ + a3$
                END IF
 
                IF mark% THEN
                    FOR i% = i1% TO i2%
                        x$(i%) = ""
                    NEXT
                ELSE
                    x$(i1%) = ""
                END IF
 
                wrap.on% = -1: GOSUB wrapper
 
                IF cur$ = "eod" THEN
                    scr = noe - page.h
                    IF scr < 0 THEN scr = 0
                    row = 1
                ELSE
                    FOR i% = 1 TO noe
                        IF INSTR(x$(i%), CHR$(4)) THEN
                            scr = i% - page.h + 1
                            IF scr < 0 THEN scr = 0
                            row = 1
                            EXIT FOR
                        END IF
                    NEXT
                END IF
 
                LOCATE row + margin.t, margin.l + 1
                filled% = page.h: GOSUB displaydoc
                GOSUB movescrollbox
                b$ = ""
        END SELECT
    END IF
 
    IF LEN(b$) OR mhl% THEN
        IF mhl% OR shift% AND INSTR("KMHPOGIQts", MID$(b$, 2, 1)) AND LEN(b$) = 2 THEN
            ' Left mouse button down or Shift key down with a highlighting key pressed.
            IF mark% = 0 THEN
                col = POS(0) - margin.l
                mark% = (row - 1) * dwidth2 + col: markrow% = row: markcol% = col ' Highlight cursor position markers.
                IF cutmrow% = 0 THEN cutmrow% = markrow% + scr: cutmcol% = markcol% ' Marks the entry row and column position for all the cummulative highlighted text and allows this text to be preserved when scrolling.
            END IF
        ELSE
            ' Disable highlight key when active and a key is pressed without Shift key held or
            IF ctrlshift% OR ctrl% AND INSTR("tsuw", MID$(b$, 2, 1)) = 0 THEN
                b$ = ""
            ELSE
                IF mark% AND LEN(b$) > 0 THEN ' Highlighted text and key press. Note: Left mouse click to clear text is in another routine.
                    IF b$ <> CHR$(3) AND b$ <> CHR$(22) AND b$ <> CHR$(24) THEN GOSUB hlwipescrn ' Use this or some other routine to clear the highlighted text off the screen.
                END IF
            END IF
        END IF
 
        IF mhl% AND locked% <> 2 THEN ' Left mouse button click or held highlighting.
            IF my% = CSRLIN THEN
                ' Lateral movement. Do nothing. Action is taken in the select case mov routine.
            ELSE ' Simulate an up or down arrow key routines for mouse highlighting when changing rows.
                IF my% < CSRLIN THEN b$ = CHR$(0) + "H" ' Highlight upwards.
                IF my% > CSRLIN THEN b$ = CHR$(0) + "P" ' Highlight downwards.
            END IF
        END IF
 
        IF keylogger% THEN
            SELECT CASE LEN(b$)
                CASE 1
                    z$ = LTRIM$(STR$(ASC(b$))) + "|"
                CASE 2
                    z$ = " " + LTRIM$(STR$(ASC(MID$(b$, 2, 1)))) + "|"
            END SELECT
            keylogger$ = keylogger$ + z$: z$ = ""
        END IF
 
        IF LEN(b$) = 1 OR b$ = CHR$(0) + "S" THEN
            IF row = 1 AND scr > 0 THEN ' Scroll screen down so cursor is on row 2 instead of 1.
                scr = scr - 1: GOSUB scrollscrn: row = row + 1: LOCATE margin.t + row, POS(0)
            END IF
 
            IF row = page.h AND row + scr < noe THEN ' Scroll screen up so cursor is on row above last row.
                scr = scr + 1: GOSUB scrollscrn: row = row - 1: LOCATE margin.t + row, POS(0)
            END IF
        END IF
 
        getkeyauto:
        row = CSRLIN - margin.t ' Needed here for auto cursor up / down changes. Also needed at display routine where wrap can make row changes if a word above is wrapped down when backspacing.
        kloop% = 0
        DO
            ' Determine cursor boundaries at end of a text line. --------------
            a$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
            IF INSTR(a$, CHR$(255)) THEN ' Special to paragraph.
                IF INSTR(MID$(a$, 2), CHR$(255)) THEN
                    n% = LEN(a$)
                END IF
                IF a$ = CHR$(255) THEN n% = 1
            ELSEIF LEN(a$) > dwidth THEN ' Space in right margin.
                n% = dwidth + ovm%
            ELSE ' All within margin length situations.
                IF row + scr < noe THEN ' Rows above last line.
                    n% = LEN(a$)
                ELSE 'Last line.
                    n% = LEN(a$) + 1
                END IF
            END IF
 
            n% = n% + margin.l
 
            ' --------------------------------------------------------------------
 
            IF autobkspdel% THEN
                IF kloop% = LEN(b$) THEN
                    b$ = b$ + CHR$(0) + "S"
                    autobkspdel% = 0
                END IF
            ELSEIF autodelforward% THEN
                IF kloop% = LEN(b$) THEN
                    b$ = b$ + CHR$(0) + "S"
                    autodelforward% = 0
                END IF
            END IF
 
            DO
                DO
                    reloop% = 0
 
                    IF mhl% AND locked% <> 2 THEN ' Left mouse key highlighting.
 
                        IF row = mhl1row% THEN ' Detect when the row in the loop matches the row marked to terminate the loop.
                            SELECT CASE mhl1col% ' Now that the loop has terminated at the marked row, find the marked column.
                                CASE 999 ' Column at loop exit is already at the marked column.
                                    mhl% = 0: EXIT DO
                                CASE ELSE ' Set col variable to mouse column marker and zero out that marker along with the simulated key press.
                                    ' New col position allows highlighter routine to highlight text on this row to this column.
                                    col = mhl1col%: LOCATE , margin.l + col
                                    mhl1col% = 999 ' 0
                                    b$ = CHR$(0) + CHR$(0): kloop% = 0 ' Important. Must nullify variable to avoid case selection below.
                            END SELECT
                        END IF
                    END IF
 
                    IF mark% AND markbypass% = 0 THEN
                        a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
                        SELECT CASE MID$(b$, 2, 1) ' Cursor movement routine. May be replace or incorporated into outer cursor movement routines.
                            CASE "I"
                                IF shift% THEN
                                    IF scr > 0 THEN
                                        k% = page.h - 1 ' The number of lines scrolled up. Ex: in a 9-line doc, scroll up 16 lines.
                                        IF k% > scr THEN k% = scr
                                        cutdrow% = row + scr - k%: cutdcol% = 1 ' No need for a reverse condition. Page Up treats them the same. For ref cutmrow% > cutdrow% is forward.
                                        scr = scr - k%
                                        LOCATE margin.t + 1, margin.l + 1
                                        FOR i% = 1 TO page.h
                                            x$ = SPACE$(dwidth + 1)
                                            a1$ = x$(i% + scr)
                                            MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
                                            LOCATE margin.t + i%, margin.l + 1
                                            PRINT x$;
                                        NEXT
                                        LOCATE margin.t + row, margin.l + 1
                                        GOSUB movescrollbox
                                    ELSE
                                        b$ = ""
                                    END IF
                                END IF
                            CASE "Q"
                                IF shift% THEN
                                    IF noe > page.h THEN
                                        k% = (page.h - 1) * 2 ' The number of lines scrolled down. Ex: in a 9-line doc, scroll down 16 lines.
                                        IF k% + scr > noe THEN k% = noe - scr - 1
 
                                        IF cutmrow% < cutdrow% OR cutdrow% = 0 THEN
                                            cutdrow% = row + scr + k% - page.h: cutdcol% = LEN(MID$(x$(row + scr + k% - page.h), 1, INSTR(x$(row + scr + k% - page.h), CHR$(10)) - 1))
                                        ELSE ' Reverse on previously highlighted text.
                                            cutdrow% = row + scr + k% - page.h + 1: cutdcol% = 1
                                        END IF
 
                                        scr = scr + k% - page.h + 1
                                        LOCATE margin.t + 1, margin.l + 1
 
                                        FOR i% = 1 TO page.h
                                            x$ = SPACE$(dwidth + 1)
                                            a1$ = x$(i% + scr)
                                            MID$(x$, 1, dwidth + 1) = MID$(a1$, 1, INSTR(a1$, CHR$(10)) - 1)
                                            LOCATE margin.t + i%, margin.l + 1
                                            PRINT x$;
                                        NEXT
 
                                        hold1% = row: row = CSRLIN - margin.t
                                        GOSUB movescrollbox
                                        LOCATE margin.t + row, margin.l + 1
                                        row = hold1%: col = 1
                                    ELSE ' Doc too small to page down.
                                        b$ = ""
                                    END IF
                                END IF
                            CASE "H"
                                IF row > 1 THEN
                                    row = row - 1
                                ELSE
                                    IF scr > 0 THEN
                                        row = row + 1: scr = scr - 1
                                        h% = 2: GOSUB scrollscrn
                                        row = 1
                                    END IF
                                END IF
                            CASE "P"
                                IF row < page.h THEN
                                    IF row + scr < noe THEN row = row + 1
                                ELSE
                                    IF row + scr < noe% THEN
                                        row = row - 1: scr = scr + 1
                                        h% = page.h - 1: GOSUB scrollscrn
                                        row = page.h
                                    END IF
                                END IF
                            CASE "M"
                                IF col < LEN(a1$) OR col = LEN(a1$) AND LEN(a1$) < dwidth + 1 AND row + scr = noe% THEN
                                    col = col + 1
                                ELSE
                                    IF row < page.h THEN
                                        IF row + scr < noe THEN row = row + 1: col = 1
                                    ELSE
                                        IF row + scr < noe% THEN
                                            row = row - 1: scr = scr + 1
                                            h% = page.h - 1: GOSUB scrollscrn
                                            row = page.h: col = 1
                                            LOCATE margin.t + row, margin.l + col
                                        END IF
                                    END IF
                                END IF
                            CASE "K"
                                IF col > 1 THEN
                                    col = col - 1
                                ELSE
                                    IF row > 1 THEN
                                        row = row - 1
                                        a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
                                        col = LEN(a1$): IF col < dwidth - 1 THEN col = col + 1
                                        IF LEFT$(a1$, 1) = CHR$(255) THEN col = 1
                                    ELSE
                                        IF scr > 0 THEN
                                            row = row + 1: scr = scr - 1
                                            h% = 2: GOSUB scrollscrn
                                            row = 1: a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
                                            col = LEN(a1$): IF col < dwidth - 1 THEN col = col + 1
                                            IF LEFT$(a1$, 1) = CHR$(255) THEN col = 1
                                        END IF
                                    END IF
                                END IF
                            CASE "G"
                                col = 1
                            CASE "O"
                                col = LEN(a1$): IF col < dwidth - 1 THEN col = col + 1
                                IF LEFT$(a1$, 1) = CHR$(255) THEN col = 1
                            CASE "s" ' Arrow left.
                                c_s_travel% = 0: c_s_tracker% = 0
                                k% = POS(0) - margin.l
                                a1$ = MID$(x$(row + scr), k%, 1)
                                IF a1$ = CHR$(32) THEN
                                    g% = -1 'find the first space after any solid character.
                                ELSE
                                    IF MID$(x$(row + scr), k% - 1, 1) = CHR$(32) OR k% = 1 THEN
                                        g% = 2
                                    ELSE
                                        g% = 1
                                    END IF
                                END IF
                                FOR i% = row + scr TO 1 STEP -1
                                    a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
                                    FOR j% = k% TO 1 STEP -1
                                        SELECT CASE g%
                                            CASE -1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
                                                    k% = -1: EXIT FOR
                                                END IF
 
                                                IF MID$(a1$, j%, 1) <> CHR$(32) THEN
                                                    c_s_tracker% = c_s_tracker% + 1
                                                ELSE
                                                    IF c_s_tracker% THEN k% = -1: EXIT FOR
                                                END IF
                                            CASE 1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
                                                    k% = -1: EXIT FOR
                                                END IF
 
                                                IF MID$(a1$, j%, 1) = CHR$(32) THEN
                                                    k% = -1: EXIT FOR
                                                END IF
                                            CASE 2
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
                                                    k% = -1: EXIT FOR
                                                ELSE
                                                    IF MID$(a1$, j%, 1) = CHR$(32) THEN
                                                        IF c_s_tracker% THEN k% = -1: EXIT FOR
                                                    ELSE
                                                        IF c_s_travel% THEN c_s_tracker% = c_s_tracker% + 1
                                                    END IF
                                                END IF
                                        END SELECT
                                        c_s_travel% = c_s_travel% + 1
                                    NEXT j%
                                    IF k% = -1 THEN EXIT FOR
                                    k% = LEN(MID$(x$(i% - 1), 1, INSTR(x$(i% - 1), CHR$(10)) - 1))
                                NEXT i%
 
                                col = POS(0) - margin.l: a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
                                FOR c_s_index% = 1 TO c_s_travel% - 1
                                    IF col > 1 THEN
                                        col = col - 1
                                    ELSE
                                        IF row > 1 THEN
                                            row = row - 1
                                            a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
                                            col = LEN(a1$)
                                        ELSE
                                            IF scr > 0 THEN
                                                row = row + 1: scr = scr - 1
                                                h% = 2: GOSUB scrollscrn
                                                row = 1
                                                a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
                                                col = LEN(a1$)
                                            END IF
                                        END IF
                                    END IF
 
                                    LOCATE margin.t + row, margin.l + col
 
                                    GOSUB highlighter
                                NEXT
                                b$ = "": EXIT DO
                            CASE "t"
                                c_s_travel% = 0: c_s_tracker% = 0
                                k% = POS(0) - margin.l
                                a1$ = MID$(x$(row + scr), k%, 1)
                                IF a1$ = CHR$(32) THEN g% = -1 ELSE g% = 1
                                FOR i% = row + scr TO noe
                                    a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
                                    FOR j% = k% TO LEN(a1$)
                                        SELECT CASE g%
                                            CASE -1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
                                                    k% = -1: EXIT FOR
                                                END IF
                                                IF MID$(a1$, j%, 1) <> CHR$(32) THEN
                                                    k% = -1: EXIT FOR
                                                ELSE
                                                    c_s_tracker% = c_s_tracker% + 1
                                                END IF
                                            CASE 1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
                                                    k% = -1: EXIT FOR
                                                END IF
 
                                                IF MID$(a1$, j%, 1) = CHR$(32) THEN
                                                    c_s_tracker% = c_s_tracker% + 1
                                                ELSE
                                                    IF c_s_tracker% THEN k% = -1: EXIT FOR
                                                END IF
                                        END SELECT
                                        c_s_travel% = c_s_travel% + 1
                                    NEXT j%
                                    IF k% = -1 THEN EXIT FOR
                                    k% = 1
                                NEXT i%
 
                                FOR c_s_index% = 1 TO c_s_travel%
                                    col = POS(0) - margin.l: a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
 
                                    IF col < LEN(a1$) OR col = LEN(a1$) AND LEN(a1$) < dwidth + 1 AND row + scr = noe% THEN
                                        col = col + 1
                                    ELSE
                                        IF row < page.h THEN
                                            row = row + 1: col = 1
                                        ELSE
                                            IF row + scr < noe% THEN
                                                row = row - 1: scr = scr + 1
                                                h% = page.h - 1: GOSUB scrollscrn
                                                row = page.h: col = 1
                                                LOCATE margin.t + row, margin.l + col
                                            END IF
                                        END IF
                                    END IF
                                    LOCATE margin.t + row, margin.l + col
                                    IF mark% THEN GOSUB highlighter '  Cursor may need to advance after mark% is zeroed in highlighter routine.
                                NEXT
                                b$ = "": EXIT DO
                        END SELECT
 
                        LOCATE margin.t + row, margin.l + col ' Note: Both row and col variables are relative and must be added to any left or top margin variables to appear in the proper row and column positions on the screen.
 
                        IF b$ <> CHR$(0) + "I" AND b$ <> CHR$(0) + "Q" THEN
                            GOSUB highlighter
                        ELSE
                            hold1% = row: GOSUB markercalc: h% = 0: GOSUB scrollscrn
                            row = hold1%: col = 1
                            LOCATE margin.t + row, margin.l + col
                            GOSUB markercalc
                            GOSUB movescrollbox ' Required. Scrollscrn polls this but the cursor gets repositioned, after that call, in line above.
                        END IF
 
                        a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
 
                        IF col > LEN(a1$) THEN
                            col = LEN(a1$)
                            IF col < dwidth - 1 THEN col = col + 1
                            LOCATE margin.t + row, margin.l + col ' Note: Both row and col variables are relative and must be added to any left or top margin variables to appear in the proper row and column positions on the screen.
                        END IF
 
                        IF b$ = CHR$(0) + CHR$(0) OR mhl% = 0 THEN b$ = "exit-partial": EXIT DO ELSE reloop% = 1 ' Otherwise it loops.
 
                    ELSE
 
                        SELECT CASE MID$(b$, kloop% + 1, 2)
                            CASE CHR$(13) ' Paragraph.
                                updatescrn% = 1
                                k% = POS(0) - (margin.l + border.thk)
                                IF k% > dwidth THEN
                                    ' There is a space in the margin, so leave that space and push the paragraph symbol to the line below.
                                    a$ = MID$(a$, 1, k%) + CHR$(255) + MID$(a$, k% + 1)
                                ELSE
                                    a$ = MID$(a$, 1, k% - 1) + CHR$(255) + MID$(a$, k%)
                                END IF
 
                                ' wrapper is engaged by text line instr() analysis, later.
                                curadvance% = -1
                                noe = noe + 1: REDIM _PRESERVE x$(noe + 1)
                                b$ = "exit"
                                EXIT DO
                            CASE CHR$(0) + "H"
                                IF row > 1 THEN
                                    row = row - 1
                                    LOCATE margin.t + row, POS(0)
                                    IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
                                        IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
                                    END IF
                                ELSEIF scr > 0 THEN
                                    scr = scr - 1: h% = 0: GOSUB scrollscrn
                                    IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
                                        IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
                                    END IF
                                END IF
                            CASE CHR$(0) + "P"
                                IF row < page.h AND row + scr < noe THEN
                                    row = row + 1
                                    LOCATE margin.t + row, POS(0)
                                    IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
                                        IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
                                    END IF
                                ELSEIF row + scr < noe THEN
                                    scr = scr + 1
                                    h% = 0: GOSUB scrollscrn
                                    IF INSTR(x$(row + scr), CHR$(10)) - 1 < POS(0) - margin.l THEN
                                        IF LEN(b$) = 2 THEN b$ = b$ + CHR$(0) + "O"
                                    END IF
                                ELSEIF row + scr = noe AND LEN(a$) > dwidth OR row + scr = noe AND INSTR(a$, CHR$(255)) THEN ' On last filled text line.
                                    IF noe = UBOUND(x$) OR row = page.h THEN
                                        noe = noe + 1
                                        REDIM _PRESERVE x$(noe)
                                        scr = scr + 1: h% = 0: GOSUB scrollscrn
                                    ELSE
                                        row = row + 1
                                        GOSUB movescrollbox
                                    END IF
                                    LOCATE margin.t + row, margin.l + 1
                                END IF
                            CASE CHR$(0) + "s" ' Arrow left.
                                c_s_travel% = 0: c_s_tracker% = 0
                                k% = POS(0) - margin.l
                                a1$ = MID$(x$(row + scr), k%, 1)
                                IF a1$ = CHR$(32) THEN
                                    g% = -1 'find the first space after any solid character.
                                ELSE
                                    IF MID$(x$(row + scr), k% - 1, 1) = CHR$(32) OR k% = 1 THEN
                                        g% = 2
                                    ELSE
                                        g% = 1
                                    END IF
                                END IF
                                FOR i% = row + scr TO 1 STEP -1
                                    a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
                                    FOR j% = k% TO 1 STEP -1
                                        SELECT CASE g%
                                            CASE -1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
                                                    k% = -1: EXIT FOR
                                                ELSE
                                                    IF MID$(a1$, j%, 1) <> CHR$(32) THEN
                                                        c_s_tracker% = c_s_tracker% + 1
                                                    ELSE
                                                        IF c_s_tracker% THEN k% = -1: EXIT FOR
                                                    END IF
                                                END IF
                                            CASE 1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
                                                    k% = -1: EXIT FOR
                                                ELSE
                                                    IF MID$(a1$, j%, 1) = CHR$(32) THEN
                                                        k% = -1: EXIT FOR
                                                    END IF
                                                END IF
                                            CASE 2
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% > 1 THEN
                                                    k% = -1: EXIT FOR
                                                ELSE
                                                    IF MID$(a1$, j%, 1) = CHR$(32) THEN
                                                        IF c_s_tracker% THEN k% = -1: EXIT FOR
                                                    ELSE
                                                        IF c_s_travel% THEN c_s_tracker% = c_s_tracker% + 1
                                                    END IF
                                                END IF
                                        END SELECT
                                        c_s_travel% = c_s_travel% + 1
                                    NEXT j%
                                    IF k% = -1 THEN EXIT FOR
                                    k% = LEN(MID$(x$(i% - 1), 1, INSTR(x$(i% - 1), CHR$(10)) - 1))
                                NEXT i%
 
                                FOR c_s_index% = 1 TO c_s_travel% - 1: autokey = -1: b$ = CHR$(0) + "K": GOSUB getkeyauto: NEXT
                            CASE CHR$(0) + "t"
                                c_s_travel% = 0: c_s_tracker% = 0
                                k% = POS(0) - margin.l
                                a1$ = MID$(x$(row + scr), k%, 1)
                                IF a1$ = CHR$(32) THEN g% = -1 ELSE g% = 1
                                FOR i% = row + scr TO noe
                                    a1$ = MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
                                    FOR j% = k% TO LEN(a1$)
                                        SELECT CASE g%
                                            CASE -1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
                                                    k% = -1: EXIT FOR
                                                    IF MID$(a1$, j%, 1) <> CHR$(32) THEN
                                                        k% = -1: EXIT FOR
                                                    ELSE
                                                        c_s_tracker% = c_s_tracker% + 1
                                                    END IF
                                                END IF
                                            CASE 1
                                                IF MID$(a1$, j%, 1) = CHR$(255) AND c_s_travel% THEN
                                                    k% = -1: EXIT FOR
                                                ELSE
                                                    IF MID$(a1$, j%, 1) = CHR$(32) THEN
                                                        c_s_tracker% = c_s_tracker% + 1
                                                    ELSE
                                                        IF c_s_tracker% THEN k% = -1: EXIT FOR
                                                    END IF
                                                END IF
                                        END SELECT
                                        c_s_travel% = c_s_travel% + 1
                                    NEXT j%
                                    IF k% = -1 THEN EXIT FOR
                                    k% = 1
                                NEXT i%
 
                                FOR c_s_index% = 1 TO c_s_travel%: autokey = -1: b$ = CHR$(0) + "M": GOSUB getkeyauto: NEXT
                            CASE CHR$(0) + "K"
                                IF POS(0) > margin.l + 1 + border.thk THEN
                                    LOCATE , POS(0) - 1
                                ELSE
                                    IF row = 1 AND scr = 0 THEN
                                        ' Do nothing.
                                    ELSE
                                        b$ = b$ + CHR$(0) + "H" + CHR$(0) + "O"
                                    END IF
                                END IF
                            CASE CHR$(0) + "M"
                                IF POS(0) < n% THEN
                                    LOCATE , POS(0) + 1
                                ELSE
                                    IF row + scr < noe OR row + scr = noe AND LEN(a$) > dwidth OR row + scr = noe AND INSTR(a$, CHR$(255)) THEN
                                        b$ = b$ + CHR$(0) + "P" + CHR$(0) + "G"
                                    END IF
                                END IF
                            CASE CHR$(0) + "I"
                                LOCATE , margin.l + 1
                                k% = page.h - 1 + row - 2
                                FOR j% = 0 TO k%
                                    b$ = b$ + CHR$(0) + "H"
                                NEXT
                                FOR j% = 1 TO row - 1
                                    b$ = b$ + CHR$(0) + "P"
                                NEXT
                                b$ = b$ + CHR$(0) + "G"
                            CASE CHR$(0) + "Q"
                                LOCATE , margin.l + 1
                                k% = (page.h - 1) + (page.h - row) - 1
                                FOR j% = 0 TO k%
                                    b$ = b$ + CHR$(0) + "P"
                                NEXT
                                FOR j% = 1 TO page.h - row
                                    b$ = b$ + CHR$(0) + "H"
                                NEXT
                                b$ = b$ + CHR$(0) + "G"
                            CASE CHR$(0) + "G" ' Cursor home on current line.
                                LOCATE , margin.l + 1
                            CASE CHR$(0) + "O" ' Cursor end on current line.
                                IF kloop% = 0 THEN ' User key press.
                                    IF row + scr < noe AND n% - margin.l <= dwidth AND INSTR(a$, CHR$(255)) = 0 THEN
                                        LOCATE , n% + 1 ' Allows more text to be added to the line in front of the last character.
                                    ELSE ' last line
                                        LOCATE , n%
                                    END IF
                                ELSE ' Automated cursor advance. For these routines, the cursor never goes past last character.
                                    LOCATE , n%
                                END IF
                            CASE CHR$(0) + "w" ' Ctrl + Home
                                row = 1
                                IF scr > 0 THEN
                                    scr = 0
                                    h% = 0: GOSUB scrollscrn
                                END IF
                                LOCATE margin.t + 1, margin.l + 1
                            CASE CHR$(0) + "u" ' Ctrl + End
                                IF noe > page.h THEN
                                    row = page.h
                                    scr = noe - row
                                    LOCATE margin.t + 1, margin.l + 1
                                    h% = 0: GOSUB scrollscrn
                                    LOCATE margin.t + page.h, margin.l + dwidth
                                ELSE
                                    row = noe
                                    LOCATE margin.t + row, margin.l + dwidth
                                END IF
                                IF LEN(MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)) = dwidth + 1 THEN b$ = b$ + CHR$(0) + "P"
                                b$ = b$ + CHR$(0) + "O"
                            CASE CHR$(0) + "R"
                                IF ins% = 30 THEN ins% = 7 ELSE ins% = 30
                                LOCATE , , 1, 7, ins%
                            CASE CHR$(9)
                                RUN
                            CASE CHR$(27)
                                SYSTEM
                            CASE CHR$(0) + "S"
                                IF row = 1 AND scr = 0 THEN IF INSTR(x$(1), CHR$(10)) <= 0 THEN b$ = "": EXIT DO
                                updatescrn% = 1
                                IF POS(0) - margin.l > LEN(a$) AND row + scr < noe THEN
                                    b$ = "**" + CHR$(0) + "G" + CHR$(0) + "P": autodelforward% = -1
                                ELSE ' delete the character under the cursor.
                                    a$ = MID$(a$, 1, POS(0) - margin.l - 1) + MID$(a$, POS(0) - margin.l + 1)
                                    IF a$ = "" AND INSTR(x$(row + scr), CHR$(10)) <= 1 THEN '
                                        ' Take no action. blank doc.
                                    ELSE ' Delete character from current cursor position.
                                        IF MID$(a$, POS(0) - margin.l, 1) = "" THEN
                                            IF row + scr < noe THEN ' The furthest right character on the line was deleted, and now the cursor must be positioned at the start of the next line, otherwise cur$ would be null.
                                                '1 of 2 places CUR$ replacement is set. >>>
                                                cur$ = LEFT$(x$(row + scr + 1), 1): MID$(x$(row + scr + 1), 1, 1) = CHR$(4)
                                            ELSE
                                                IF row + scr > 1 THEN
                                                    cur$ = "eod"
                                                ELSE
                                                    ' Do nothing. Single line no wrap possible.
                                                END IF
                                            END IF
                                        ELSE ' character deleted was at or between the first and next to the last character on the line.
                                            cur$ = MID$(a$, POS(0) - margin.l, 1): MID$(a$, POS(0) - margin.l, 1) = CHR$(4)
                                        END IF
                                        b$ = "exit": EXIT DO
                                    END IF
                                END IF
                            CASE CHR$(8)
                                IF POS(0) = margin.l + 1 AND row = 1 AND scr = 0 THEN
                                    ' First character of doc. Do not delete using backspace.
                                ELSE
                                    b$ = "**" + CHR$(0) + "K": autobkspdel% = -1
                                END IF
                            CASE CHR$(32) TO CHR$(127)
                                updatescrn% = 1
                                j% = POS(0)
                                k% = j% - (margin.l + border.thk)
                                ' 1 of 2 places CUR$ replacement is set. >>>
                                SELECT CASE ins%
                                    CASE 30 'Overwrite
                                        cur$ = b$
                                        IF k% <= LEN(a$) AND k% <= dwidth THEN
                                            MID$(a$, k%, 1) = CHR$(4) ' Display occurs in FOR/NEXT print to screen routine.
                                        ELSEIF j% = margin.l + dwidth + 1 THEN
                                            IF RIGHT$(a$, 1) = CHR$(32) AND LEN(a$) = dwidth + 1 THEN
                                                MID$(a$, k%, 1) = CHR$(4)
                                            ELSE
                                                a$ = a$ + CHR$(4)
                                                IF row + scr < noe AND INSTR(x$(row + scr + 1), CHR$(10)) - 1 > 1 THEN
                                                    x$(row + scr + 1) = MID$(x$(row + scr + 1), 2)
                                                END IF
                                            END IF
                                        ELSE
                                            a$ = a$ + CHR$(4)
                                        END IF
                                        curadvance% = 1: b$ = "exit"
                                        EXIT DO
                                    CASE 7 ' Insert
                                        cur$ = b$
                                        a$ = MID$(a$, 1, k% - 1) + CHR$(4) + MID$(a$, k%)
                                        curadvance% = 1: b$ = "exit"
                                        EXIT DO
                                END SELECT
 
                            CASE CHR$(0) + ">"
                                IF POS(0) - (margin.l + border.thk) < dwidth + 1 THEN
                                    LOCATE , POS(0) + 1
                                    b$ = "exit"
                                ELSE
                                    IF row + scr < noe OR row + scr = noe AND LEN(a$) > dwidth THEN
                                        b$ = b$ + CHR$(0) + "P" + CHR$(0) + "G"
                                    END IF
                                END IF
                            CASE CHR$(0) + "^"
                                IF row = page.h THEN
                                    scr = scr + 1
                                    GOSUB scrollscrn
                                ELSE
                                    row = row + 1
                                    GOSUB movescrollbox
                                END IF
 
                                LOCATE margin.t + row, margin.l + 1
                                b$ = "exit"
 
                            CASE CHR$(0) + CHR$(0)
                                b$ = "exit-partial"
                            CASE ""
                                b$ = "exit": EXIT DO
                        END SELECT
 
                        row = CSRLIN - margin.t
 
                        kloop% = kloop% + 2
                        IF kloop% > 4 AND curadvance% THEN b$ = "exit": EXIT DO ' Allow a coming return back to the curadvance gosub getkeyauto line.
 
                    END IF ' mark% vs non-mark%
 
                LOOP WHILE reloop%
 
            LOOP UNTIL mhl% = 0
 
            IF MID$(b$, 1, 4) = "exit" THEN EXIT DO ' exit and exit-partial exits here.
        LOOP
        IF b$ = "exit-partial" THEN b$ = ""
 
    END IF
 
    IF b$ = "exit" THEN b$ = "": EXIT DO
 
    ' Audit Mouse Routines ====================================================
    DO
        mb.w = 0
        WHILE _MOUSEINPUT
            mb.w = mb.w + _MOUSEWHEEL
        WEND
 
        IF mb.w = 0 THEN
            mx% = _MOUSEX ' Mouse column.
            my% = _MOUSEY ' Mouse row.
            mb.l = _MOUSEBUTTON(1)
            mb.r = _MOUSEBUTTON(2)
            mb.m = _MOUSEBUTTON(3)
        END IF
 
        IF locked% < 0 THEN ' Mouse effects on mouse lock. key press effects are determined at inkey$ input, as key variable cannot be evaluated here, due to b$ = "" manipulations in the keypress routine.
            IF mb.l OR mb.r OR mb.m THEN locked% = 0
        END IF
 
        IF mb.w THEN ' Determine if wheel is being used to scroll highlighted or unhighlighted text.
            IF shift% THEN
                locked% = -1
                mhl1row% = row: mhl1col% = col: mhl1% = (row - 1) * dwidth2 + col
            ELSE
                locked% = 2 ' 2 is lock scrollbar, no highlighting permitted.
            END IF
        END IF
 
        IF mb.l AND locked% <> 1 OR mb.w AND locked% <> -1 THEN
            ' Scrollbar routine.
            IF mx% >= scrb.l - 1 AND mx% <= scrb.l + 1 AND my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 THEN draglock% = -1
            IF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR mx% = scrb.l AND scrb.s <> 0 AND my% >= scrb.t AND my% <= scrb.b AND mb.w = 0 OR scrbardrag% <> 0 AND my% > scrb.t AND my% < scrb.b AND mb.w = 0 OR mb.w > 0 AND scrb.x + scrb.s < scrb.h OR mb.w < 0 AND scrb.x > 0 THEN ' Mouse on scrollbar, doing a bar cursor drag or using the scroll wheel.
                locked% = 2 ' Locked on scrollbar
                IF my% = scrb.t AND scrb.x > 0 OR my% = scrb.b AND scrb.x + scrb.s < scrb.h OR mb.w <> 0 THEN ' Mouse on a scrollbar arrow.
                    IF my% = scrb.t AND mb.w = 0 OR mb.w < 0 THEN scrb.x = scrb.x - 1: h% = -1 ELSE scrb.x = scrb.x + 1: h% = -2 ' Top or bottom arrow.
                    IF mb.w = 0 THEN delay.on! = .15
                    j% = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
 
                    IF j% >= 0 THEN ' Condition exists unless j% is negative such as doc is blank and mouse wheel is rolled downward.
                        scrb.i = j%
 
                        IF mark% = 0 THEN h% = 0 ' h% was assigned a few lines up but gets zeroed here if there is no highlighting.
 
                        scr = scrb.i
 
                        GOSUB makescrb ' Positions scrollbar box.
 
                        GOSUB scrollscrn
                    END IF
 
                ELSEIF my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 AND scrbardrag% = 0 THEN ' Mouse on scrollbar block.
                    scrbardrag% = -1: scrb.adjust = (my% - (scrb.t + 1)) - scrb.x
                ELSEIF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR my% > scrb.t AND my% < scrb.b THEN ' Mouse on scrollbar between scrollbar arrow and cursor.
                    IF draglock% = -1 AND my% > scrb.t AND my% < scrb.b OR my% - (scrb.t + 1) - scrb.adjust >= 0 AND my% - (scrb.t + 1) + scrb.s - scrb.adjust <= scrb.h AND scrbardrag% <> -1 OR scrbardrag% = 0 THEN
                        IF scrbardrag% = 0 THEN ' No drag, so adjust for cursor length for a click inside the scrollbar above or below the current scrollbar cursor position.
                            IF my% - (scrb.t + 1) > scrb.x THEN
                                scrb.adjust = (my% - (scrb.t + 1)) - scrb.x - 1: h% = -1
                            ELSE
                                scrb.adjust = (my% - (scrb.t + 1)) - scrb.x + 1: h% = -2
                            END IF
                        END IF
                        scrb.x = my% - (scrb.t + 1) - scrb.adjust
                        scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
 
                        IF mark% = 0 THEN h% = 0 ' h% was assigned a few lines up but gets zeroed here if there is no highlighting.
 
                        scr = scrb.i
 
                        GOSUB makescrb
 
                        GOSUB scrollscrn
 
                    ELSE ' Scrollbar is at top or bottom and mouse cursor is moving vertically along the scrollbar cursor. This allows the variable to readjust.
                        IF mx% = scrb.l THEN scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
                    END IF
                END IF
                ' =======================================================
 
                IF scr < cursor.top OR scr > cursor.bot THEN
                    LOCATE , , 0: curhide% = -1
                ELSE
                    IF mark% = 0 THEN
                        IF row + scr <> cursor.scbrrow AND cursor.scbrrow <> 0 THEN
                            row = cursor.scbrrow - scr
                            LOCATE margin.t + row, POS(0)
                        END IF
                        LOCATE , , 1: curhide% = 0
                    ELSE
                        LOCATE , , 1: curhide% = 0
                    END IF
                END IF
 
            END IF
 
            IF delay.on! THEN ' Scrollbar delay.
                _DELAY delay.on!
                delay.on! = 0 ' Toggle off.
            END IF
 
            IF locked% = 2 THEN EXIT DO
        ELSE
            scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
            IF locked% = 2 AND mb.l = 0 THEN locked% = 0
        END IF
 
        IF mb.w AND locked% = -1 THEN ' shift key down. Mouse wheel highlighting.
            IF mb.w > 0 THEN
                b$ = CHR$(0) + "P"
            ELSE
                b$ = CHR$(0) + "H"
            END IF
            autokey% = -1 ' Note: Gosub getkeyauto will not work here.
            EXIT DO
        END IF
 
        IF mb.l THEN
            IF mx% > margin.l AND mx% <= margin.l + dwidth + 1 AND my% >= margin.t + 1 AND my% <= margin.t + page.h OR mark% <> 0 AND locked% = 1 OR mark% <> 0 AND locked% = 3 THEN ' Cursor in-bounds.
                IF curhide% THEN curhide% = 0: row = my% - margin.t: col = mx% - margin.l: LOCATE margin.t + row, margin.l + col, 1: EXIT DO
                j% = 0: ii2% = my% - margin.t
                IF ii2% < 1 THEN
                    ii2% = 1
                    j% = -1
                    locked% = 3
                ELSEIF ii2% > noe THEN
                    ii2% = noe
                    j% = 1
                    locked% = 3
                ELSEIF ii2% > page.h THEN
                    ii2% = page.h
                    j% = 1
                    locked% = 3
                END IF
 
                a1$ = MID$(x$(ii2% + scr), 1, INSTR(x$(ii2% + scr), CHR$(10)) - 1)
 
                mxalt% = mx%
                IF mx% < margin.l + 1 THEN mxalt% = margin.l + 1
                IF mx% > margin.l + LEN(a1$) THEN
                    mxalt% = margin.l + LEN(a1$) + 1
                    IF mxalt% - margin.l > dwidth + 1 THEN mxalt% = margin.l + dwidth + 1
                END IF
                IF INSTR(a1$, CHR$(255)) THEN
                    IF LEFT$(a1$, 1) = CHR$(255) THEN
                        mxalt% = margin.l + 1
                    ELSE
                        IF mx% - margin.l > LEN(a1$) THEN maxalt% = margin.l + LEN(a1$) - 1
                    END IF
                END IF
 
                IF my% > margin.t + page.h OR my% < margin.t + 1 THEN
                    IF mark% THEN
                        IF j% = -1 THEN
                            IF scr > 0 THEN
                                col = mxalt% - margin.l
                                LOCATE margin.t + ii2%, margin.l + col
                                row = row + 1: scr = scr - 1
                                h% = 2: GOSUB scrollscrn
                                row = CSRLIN - margin.t
                            END IF
                        ELSE
                            IF ii2% + scr < noe% THEN
                                col = mxalt% - margin.l
                                LOCATE margin.t + ii2%, margin.l + col
                                row = row - 1: scr = scr + 1
                                h% = page.h - 1: GOSUB scrollscrn
                                row = CSRLIN - margin.t
                            END IF
                        END IF
                    END IF
                END IF
 
                IF mhlclear% THEN ' Check to see if highlighting should be removed.
                    IF shift% THEN ' Do not remove highlighted text.
                        mhlclear% = 0
                    ELSE
                        GOSUB hlwipescrn ' Remove highlighted text.
                    END IF
                END IF
 
                IF shift% OR (ii2% - 1) * dwidth2 + mxalt% - margin.l <> mhl1% AND mhl1% <> 0 THEN
                    mhl% = -1 ' Left mouse key highlighting enabled when Shift key held and left mouse button click or when Shift held or not held if left mouse button is held while changing row/column (drag).
                    locked% = 1
                    mhl1row% = ii2%: mhl1col% = mxalt% - margin.l: mhl1% = (ii2% - 1) * dwidth2 + mxalt% - margin.l
                    EXIT DO
                ELSE
                    IF mhl1% <> (ii2% - 1) * dwidth2 + mxalt% - margin.l THEN
                        mhl1% = (ii2% - 1) * dwidth2 + mxalt% - margin.l
                        row = ii2%: col = mxalt% - margin.l
                        LOCATE margin.t + row, margin.l + col
                        curhide% = 0: GOSUB getcurinfo: LOCATE , , 1
                    END IF
                END IF
            END IF
        ELSE
            mhl1% = 0 ' Left mouse button not engaged so zero the highlighting marker.
            IF locked% AND mb.w = 0 THEN locked% = 0 ' Undo mouse lock unless mouse wheel is in current use.
            IF mark% THEN mhlclear% = -1 ' Will be triggered the next time the left mouse button is pressed to remove all highlighted text.
        END IF
        EXIT DO
    LOOP ' Mouse loop terminates here.
LOOP
 
IF noe < row + scr THEN noe = row + scr
RETURN ' ==================================================================
 
'==========================================================================
'                                  NOTES
$IF  THEN
    INSTR(x$(c%), CHR$(10)) > 1 Indicates an array with text.
    INSTR(x$(row + scr), CHR$(10)) <= 1 Indicates an array without text.
    Value = 0: (Valid)   Array is empty with no EOL.
    Value = 1: (Invalid) Array is empty but has a EOL added. This should not be present, but I think it occurs when a line is initially erased. This needs more investigation.
    Value > 1: (Valid)   Array contains text.
$END IF
'==========================================================================
 
getvar_setscrn:
scrn.w = _WIDTH
scrn.h = _HEIGHT
scrb.x = 0 ' Relative position of the scrollbar cursor from top of scrb.h. 0 Off / 1 to
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.t = margin.t + 1
scrb.b = margin.t + page.h
scrb.l = margin.l + page.w + 2
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.d = scrb.b - scrb.t + 1
scrb.h = scrb.b - scrb.t - 1 ' Max. vertical scroll. Bar minus the top and bottom arrow symbols.
 
IF noe THEN
    a$ = "": row = 1: scr = 0
    FOR i% = 1 TO noe
        a$ = a$ + MID$(x$(i%), 1, INSTR(x$(i%), CHR$(10)) - 1)
    NEXT
    wrap.on% = -1: GOSUB wrapper
    noe = filled%: filled% = 0
END IF
 
WIDTH scrn.w, scrn.h: CLS
LOCATE margin.t + 1, margin.l + 1, 1, 7, ins%
row = CSRLIN - margin.t: scr = 0
filled% = noe
 
IF page.h > noe THEN
    scrb.s = 0 ' No scroll box required.
ELSE
    IF scrb.opt = 0 THEN
        scrb.s = (scrb.h + 1) * 2 - noe: IF scrb.s <= 0 THEN scrb.s = 1
    ELSE
        scrb.s = 1
    END IF
END IF
 
IF row = 0 THEN row = 1
IF page.c = 0 THEN page.c = 7 ' Cursor apearance as underline.
 
GOSUB displaydoc
 
LOCATE margin.t + row, margin.l + 1, 1, 7, page.c
RETURN
 
movescrollbox:
IF page.h > noe THEN
    scrb.s = 0 ' No scroll box required.
    RETURN ' Required to prevent unhandled conditions in scrollbar box movement.
ELSE
    IF scrb.opt = 0 THEN
        scrb.s = (scrb.h + 1) * 2 - noe: IF scrb.s <= 0 THEN scrb.s = 1
    ELSE
        scrb.s = 1
    END IF
END IF
IF scr = 0 THEN
    scrb.x = 0
ELSE
    IF scrb.x < page.h - 3 AND row + scr >= INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h THEN
        scrb.x = 0
        DO UNTIL scrb.x = scrb.h - scrb.s OR page.h + scr < INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h
            scrb.x = scrb.x + 1
        LOOP
 
    ELSEIF row + scr < scrb.i THEN
        scrb.x = page.h - 3
        DO UNTIL page.h + scr > INT((scrb.x + 1 - 2) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h
            scrb.x = scrb.x - 1
        LOOP
    END IF
END IF
 
IF scrb.x + scrb.s > scrb.h THEN ' Scrollbox expansion adjustment.
    scrb.x = scrb.h - scrb.s
END IF
 
GOSUB makescrb
 
scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
RETURN
 
makescrb:
yy% = CSRLIN: xx% = POS(0)
LOCATE scrb.t, scrb.l
COLOR 0, 7
PRINT CHR$(24);
COLOR 7, 0
FOR i% = 1 TO scrb.h
    LOCATE scrb.t + i%, scrb.l
    PRINT CHR$(177);
NEXT i%
LOCATE scrb.b, scrb.l
COLOR 0, 7
PRINT CHR$(25);
COLOR 7, 0
IF noe > scrb.h + 2 THEN
    FOR i% = 1 TO scrb.s
        LOCATE scrb.t + scrb.x + i%, scrb.l
        COLOR 1, 0
        PRINT CHR$(176); ' Scrollbar box.
    NEXT
    COLOR 7, 0
END IF
LOCATE yy%, xx%
RETURN
 
getcurinfo:
cursor.scbrrow = row + scr
cursor.scbrcol = POS(0) - margin.l
cursor.holdscr = scr
cursor.holdrow = row
cursor.top = scr - page.h + row
cursor.bot = scr + row - 1
cursor.holdscrbx = scrb.x
RETURN
 
backtocursor:
scr = cursor.holdscr
row = 1
LOCATE margin.t + row, margin.l + 1
filled% = page.h: GOSUB displaydoc
row = cursor.holdrow
col = cursor.scbrcol
scrb.x = cursor.holdscrbx
scrb.i = scr
curhide% = 0
GOSUB getcurinfo
LOCATE margin.t + row, margin.l + col, 1
RETURN
 
highlighter:
yy% = CSRLIN: xx% = POS(0)
 
IF cutmrow% THEN
    cutdrow% = row + scr: cutdcol% = col ' Also found in scrollscrn routine.
END IF
 
IF o% = 0 THEN
    o% = mark%
ELSE
    o% = d% ' o% is the start marker or last marker. If zero, it is the same as the start marker (mark%) but if the highlighting process is ongoing, it is the same as the last highlighting marker (d%).
END IF
 
hlbypass% = -1: GOSUB markercalc ' o% has already been set. hlbypass% gets zeroed in gosub statement.
 
IF d% >= o% THEN mov% = 1 ELSE mov% = -1: ' Difference between origin and destination markers determine if the movement is positive (right, down) or negative (left, up).
 
SELECT CASE mov%
    CASE 1 ' End, right, or down
        x1% = o1%: x2% = o2%: LOCATE margin.t + x1%, margin.l + x2%
        a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
        ' Highlighting on line above, from origin row.
        IF x1% = markrow% AND o1% = d1% AND mhl% THEN ' Mouse only when the origin row is the same as the original marker row and the destination row is the same as the origin row. This is right movement within the same line of text.
            i% = 0: DO UNTIL i% = d2% - x2%: GOSUB getcolor: PRINT MID$(a1$, x2% + i%, 1);: i% = i% + 1: LOOP
        ELSEIF x1% = markrow% AND ABS(o% - d%) > 1 THEN ' End key press. Exclude mouse here, as down mouse highlighting is done in a conditional statement, below.
            GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(o2% - markcol%)); ' Print from origin column to initial marker column.
            GOSUB getcolor: PRINT MID$(a1$, x2% + ABS(o2% - markcol%)); ' Print from initial marker column to destination column.
        ELSE ' Right arrow key, down arrow key or mouse moving down.
            GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(o1% - d1%) * dwidth2 + ABS(o2% - d2%)); ' Trick method to determine length of highlighting.
        END IF
 
        IF o1% - d1% THEN ' Highlighting on current row after row above is finished.
            x1% = row: x2% = col: LOCATE margin.t + x1%, margin.l + 1
            a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
            IF x1% = markrow% AND ABS(o% - d%) > 1 THEN ' Highlight the destination row if downward move is made after an upward highlight has been made.
                IF d2% < markcol% THEN i% = d2% ELSE i% = markcol% ' Set i% to the furthest column.
                GOSUB getcolor: PRINT MID$(a1$, 1, i% - 1); ' unhighlight to the furthest column.
                GOSUB getcolor: PRINT MID$(a1$, i%, ABS(d2% - i%));
            ELSE ' Arrow down or mouse downward, either with original marker row on same line.
                GOSUB getcolor: PRINT MID$(a1$, 1, d2% - 1); ' Highlight from first column on current row to destination on current row.
            END IF
        END IF
 
    CASE -1 ' Home, up, or Left.
        x1% = row: x2% = col: LOCATE margin.t + x1%, margin.l + x2%
        a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
 
        IF x1% = markrow% AND o1% = d1% AND mhl% THEN ' Mouse only when the origin row is the same as the original marker row and the destination row is the same as the origin row. This is left movement within the same line of text.
            IF mx% - margin.l <= LEN(a1$) THEN
                i% = 0: DO UNTIL i% = o2% - x2%: GOSUB getcolor: PRINT MID$(a1$, x2% + i%, 1);: i% = i% + 1: LOOP
            END IF
        ELSEIF x1% = markrow% AND ABS(o1% - d1%) >= 1 THEN ' Mouse or arrow back up to highlighted line above.
            GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(d2% - markcol%)); ' Highlight from cursor to previously highlighted text to the right, if any.
            GOSUB getcolor: PRINT MID$(a1$, x2% + ABS(d2% - markcol%)); ' Unhighlight previous text to the right.
        ELSE ' Arrow left, home, arrow up or mouse upwards, either without any highlighting above.
            GOSUB getcolor: PRINT MID$(a1$, x2%, ABS(o1% - d1%) * dwidth2 + ABS(o2% - d2%)); ' Trick method to determine length of highlighting.
        END IF
 
        IF o1% <> d1% AND d2% <= o2% THEN ' Bottom line with arrow up or mouse upwards. Note: Mouse initially moves straight up, and moves laterally in another pass. This is why o2% always equals d2% as with an arrow up move.
            x1% = o1%: x2% = o2%: LOCATE margin.t + x1%, margin.l + 1
            a1$ = MID$(x$(x1% + scr), 1, INSTR(x$(x1% + scr), CHR$(10)) - 1)
 
            IF x1% = markrow% THEN
                IF markcol% >= d2% THEN i% = d2% ELSE i% = markcol%
                GOSUB getcolor: PRINT MID$(a1$, 1, i% - 1);
                GOSUB getcolor: PRINT MID$(a1$, i%, ABS(i% - d2%));
            ELSE
                IF x1% = page.h AND dmodify% THEN d2% = d2% + dmodify%
                GOSUB getcolor: PRINT MID$(a1$, 1, d2% - 1);
            END IF
        END IF
END SELECT
 
dmodify% = 0
IF d% = mark% THEN GOSUB clearmarkers
 
COLOR c1%, c2%
LOCATE yy%, xx%
 
GOSUB movescrollbox
 
RETURN
 
getcolor: ' Reads the screen under the cursor and reverses the colors.
IF POS(0) - margin.l > dwidth + 1 THEN ' Cursor in scrollbar space after full line of text was printed.
    COLOR h1%, h2%
ELSE
    IF SCREEN(CSRLIN, POS(0), 1) <> 7 THEN COLOR c1%, c2% ELSE COLOR h1%, h2%
END IF
RETURN
 
copytext:
_CLIPBOARD$ = "": myCLIPBOARD$ = ""
i1% = cutmrow%: i2% = cutdrow%
IF i1% > i2% THEN SWAP i1%, i2%
j% = cutmcol%: k% = cutdcol%
IF cutmrow% > cutdrow% THEN SWAP j%, k%
 
IF cutmrow% = cutdrow% THEN
    myCLIPBOARD$ = MID$(x$(i1%), j%, k% - j%)
    IF INSTR(myCLIPBOARD$, CHR$(255)) THEN a1$ = myCLIPBOARD$: MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = a1$ + CHR$(10) ELSE _CLIPBOARD$ = myCLIPBOARD$
ELSE
    a1$ = MID$(MID$(x$(i1%), 1, INSTR(x$(i1%), CHR$(10)) - 1), j%)
    myCLIPBOARD$ = a1$
    IF INSTR(a1$, CHR$(255)) THEN MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = _CLIPBOARD$ + a1$ + CHR$(10) ELSE _CLIPBOARD$ = _CLIPBOARD$ + a1$
    FOR i% = 1 TO i2% - i1% - 1
        a1$ = MID$(x$(i1% + i%), 1, INSTR(x$(i1% + i%), CHR$(10)) - 1)
        myCLIPBOARD$ = myCLIPBOARD$ + a1$
        IF INSTR(a1$, CHR$(255)) THEN MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = _CLIPBOARD$ + a1$ + CHR$(10) ELSE _CLIPBOARD$ = _CLIPBOARD$ + a1$
    NEXT
    a1$ = MID$(x$(i2%), 1, k% - 1)
    myCLIPBOARD$ = myCLIPBOARD$ + a1$
    IF INSTR(a1$, CHR$(255)) THEN MID$(a1$, INSTR(a1$, CHR$(255)), 1) = CHR$(13): _CLIPBOARD$ = _CLIPBOARD$ + a1$ + CHR$(10) ELSE _CLIPBOARD$ = _CLIPBOARD$ + a1$
END IF
RETURN
 
singlelinedelete:
a1$ = MID$(x$(row + scr), 1, INSTR(x$(row + scr), CHR$(10)) - 1)
IF cutmcol% < cutdcol% THEN j% = cutmcol%: k% = cutdcol% ELSE j% = cutdcol%: k% = cutmcol%
GOSUB clearmarkers
a2$ = MID$(a1$, 1, j% - 1)
a3$ = MID$(a1$, k%)
IF a3$ = "" THEN
    cur$ = "eod"
ELSE
    cur$ = MID$(a3$, 1, 1): MID$(a3$, 1, 1) = CHR$(4)
END IF
a$ = a2$ + a3$
RETURN
 
multilinedelete:
i1% = cutmrow%: i2% = cutdrow%
j% = cutmcol%: k% = cutdcol%
IF i1% > i2% THEN SWAP i1%, i2%: SWAP j%, k% ' Highlighting was upwards instead of downwards.
 
GOSUB clearmarkers
 
oldrow = row: oldscr = scr
a2$ = MID$(x$(i1%), 1, j% - 1)
a1$ = MID$(x$(i2%), 1, INSTR(x$(i2%), CHR$(10)) - 1)
a3$ = MID$(a1$, k%)
b$ = ""
 
IF a3$ = "" THEN
    IF i2% < noe THEN
        cur$ = MID$(x$(i2% + 1), 1, 1): MID$(x$(i2% + 1), 1, 1) = CHR$(4)
    ELSE
        cur$ = "eod"
    END IF
ELSE
    cur$ = MID$(a3$, 1, 1): MID$(a3$, 1, 1) = CHR$(4)
END IF
 
a$ = a2$ + a3$
 
IF i1% > 1 THEN
    i1% = i1% - 1
    a1$ = MID$(x$(i1%), 1, INSTR(x$(i1%), CHR$(10)) - 1)
    a$ = a1$ + a$
END IF
 
FOR i% = i1% TO i2%
    x$(i%) = ""
NEXT
 
row = 1: scr = i1% - row
 
a1$ = "": a2$ = "": a3$ = ""
wrap.on% = -1: GOSUB wrapper
REDIM _PRESERVE x$(noe + 1)
 
IF noe < page.h THEN GOSUB wipescrn ' Wipe screen.
 
LOCATE row + margin.t, margin.l + 1
 
IF i1% < oldscr THEN ELSE scr = oldscr
 
IF scr > 0 THEN ' Adjust towards bottom of screen.
    IF noe - scr < page.h THEN
        scr = noe - page.h - 1
        IF scr < 0 THEN scr = 0
    END IF
END IF
 
filled% = page.h: GOSUB displaydoc
GOSUB movescrollbox
RETURN
 
clipboardconvert:
myCLIPBOARD$ = _CLIPBOARD$
DO UNTIL INSTR(myCLIPBOARD$, CHR$(13) + CHR$(10)) = 0
    j% = INSTR(myCLIPBOARD$, CHR$(13) + CHR$(10))
    DO UNTIL MID$(myCLIPBOARD$, j%, 2) <> CHR$(13) + CHR$(10)
        myCLIPBOARD$ = MID$(myCLIPBOARD$, 1, j% - 1) + CHR$(255) + MID$(myCLIPBOARD$, j% + 2)
        j% = j% + 2
    LOOP
LOOP
RETURN
 
debugger:
ss% = CSRLIN: tt% = POS(0)
LOCATE 1, 42
PRINT "mark rw col"; mark%; markrow%; markcol%; "   "
LOCATE , 42
PRINT "orig  o1 o2"; o%; "o1% ="; o1%; "o2% ="; o2%; "   "
LOCATE , 42
PRINT "dest  d1 d2"; d%; "d1% ="; d1%; "d2% ="; d2%; "   "
IF mov% > 0 THEN mov$ = "pos" ELSE IF mov% < 0 THEN mov$ = "neg" ELSE mov$ = "neutral"
LOCATE , 42
PRINT "moving     "; mov$; "   "
LOCATE , 42
PRINT "o2 - d2 =  "; ABS(o1% - d1%); ABS(o2% - d2%); "   "
LOCATE , 42
PRINT "yy%   xx%  "; yy%; xx%; "   "
LOCATE , 42
PRINT "yy% multi  "; (yy% - 1) * dwidth + col; "   "
LOCATE , 42
PRINT "cutmrow%   "; cutmrow%; cutmcol%; "   "
LOCATE , 42
PRINT "cutdrow%   "; cutdrow%; cutdcol%; "   "
LOCATE , 42
PRINT "row col scr"; row; col; scr; "   "
LOCATE , 42
PRINT "mhl1%      "; mhl1%; "   "
LOCATE , 42
PRINT "mhl1row%   "; mhl1row%; "   "
LOCATE , 42
PRINT "mhl1col%   "; mhl1col%; "   "
LOCATE , 42
PRINT "locked%    "; locked%; "   "
LOCATE , 42
PRINT "scrb.x  i s"; scrb.x; scrb.i; scrb.s; "   "
LOCATE , 42
PRINT "b$         "; b$; kloop%; "            "
LOCATE , 42
IF LEN(cur$) THEN cur% = ASC(cur$) ELSE cur% = 0
PRINT "cur$ cur%  "; cur$; cur%; ""
LOCATE , 42
PRINT "noe uboundx "; noe; UBOUND(x$); "            "
LOCATE , 42
PRINT "cursor.t / b"; cursor.top; cursor.bot; "    ";
LOCATE , 42
PRINT "scrbardrag% "; scrbardrag%; draglock%; "    ";
LOCATE ss%, tt%
RETURN
 

It's really rough, and probably buggy. This is the stage where I start renaming variables, optimize the code and re-order the gosubs to better match the program flow, but this is as far along I am for now. Sorry, no save yet, but you can type in it or take any typed out text and copy and paste it into the app. If you select all (Ctrl + A) and copy (Ctrl + C) from the app, you can paste it to Notepad and save it as "mybetatest.txt" in the same folder you are running this app in. If you do so, you will need to change line two beta% to beta% = 2. The saved Notepad text will now open in the app at the next run.

Merry Christmas

Pete

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: TempodiBasic on December 26, 2020, 12:51:04 pm

Hi guys and gals

I had a fine idea but not so much time! So for now I post this my whishes

Code: QB64: [Select]

DIM SHARED GlInit AS INTEGER, s AS SINGLE, Glactive AS INTEGER
DIM A AS LONG, i AS SINGLE
DIM SHARED r AS SINGLE, x AS SINGLE, y AS SINGLE, w AS SINGLE
 
A = _NEWIMAGE(800, 600, 32)
 
SCREEN A
 
CONST Yellow1 = _RGB32(200, 200, 10, 255), Yellow2 = _RGB32(200, 200, 60, 255), Black = _RGB32(0, 0, 0, 255), Red = _RGB32(230, 0, 0, 255)
DO: LOOP WHILE _SCREENEXISTS = 0
_TITLE "Happy Christmas QB64 community!"
 
LOCATE 2, ((_WIDTH / 2) - 80) / 8: PRINT "Opengl graphic demo"
_DELAY 2: CLS
GlInit = -1
Glactive = -1
r = 1
z = 10
s = _PI(2) / z
DO
    IF r > 0.35 THEN r = r - 0.05
    FOR w = 0 TO _PI(2) STEP s / 2
 
        _DELAY .15
    NEXT w
LOOP UNTIL _KEYHIT <> 0
COLOR Yellow1
PRINT " Happy Christmas QB64 community"
END
 
'area subs-------------
 
'area GL --------------------
SUB _GL ()
    SHARED w AS SINGLE
    IF NOT Glactive THEN EXIT SUB
    IF GlInit THEN
        _glViewport 0, 0, _WIDTH, _HEIGHT
        _glClearColor 1, 0, 0, 1
        GlInit = 0
    END IF
    _glClear _GL_COLOR_BUFFER_BIT
    RotatingStarsFull 0, -0.2, r, -w
    IncrDrawPoint 0, -0.2, r, 10, -w
    IncrRotStarsvoid 0, -0.2, r, -w
    'Q
    RotatingStarsFull -0.7, 0.8, 0.05, -w
    RotatingStarsFull -0.8, 0.8, 0.05, -w
    RotatingStarsFull -0.9, 0.7, 0.05, -w
    RotatingStarsFull -0.9, 0.6, 0.05, -w
    RotatingStarsFull -0.9, 0.5, 0.05, -w
    RotatingStarsFull -0.8, 0.4, 0.05, -w
    RotatingStarsFull -0.7, 0.4, 0.05, -w
    RotatingStarsFull -0.6, 0.7, 0.05, -w
    RotatingStarsFull -0.6, 0.6, 0.05, -w
    RotatingStarsFull -0.6, 0.5, 0.05, -w
    RotatingStarsFull -0.55, 0.4, 0.05, -w
    'B
 
    RotatingStarsFull -0.2, 0.8, 0.05, -w
    RotatingStarsFull -0.4, 0.8, 0.05, -w
    RotatingStarsFull -0.4, 0.7, 0.05, -w
    RotatingStarsFull -0.4, 0.6, 0.05, -w
    RotatingStarsFull -0.4, 0.5, 0.05, -w
    RotatingStarsFull -0.4, 0.4, 0.05, -w
    RotatingStarsFull -0.2, 0.4, 0.05, -w
    RotatingStarsFull -0.1, 0.7, 0.05, -w
    RotatingStarsFull -0.2, 0.6, 0.05, -w
    RotatingStarsFull -0.1, 0.5, 0.05, -w
    '6
    RotatingStarsFull 0.4, 0.8, 0.05, -w
    RotatingStarsFull 0.3, 0.8, 0.05, -w
    RotatingStarsFull 0.2, 0.7, 0.05, -w
    RotatingStarsFull 0.1, 0.6, 0.05, -w
    RotatingStarsFull 0.1, 0.5, 0.05, -w
    RotatingStarsFull 0.2, 0.4, 0.05, -w
    RotatingStarsFull 0.3, 0.3, 0.05, -w
    RotatingStarsFull 0.3, 0.3, 0.05, -w
    RotatingStarsFull 0.4, 0.4, 0.05, -w
    RotatingStarsFull 0.3, 0.5, 0.05, -w
    RotatingStarsFull 0.4, 0.5, 0.05, -w
    RotatingStarsFull 0.2, 0.5, 0.05, -w
 
    '4
    RotatingStarsFull 0.8, 0.8, 0.05, -w
    RotatingStarsFull 0.7, 0.7, 0.05, -w
    RotatingStarsFull 0.8, 0.7, 0.05, -w
    RotatingStarsFull 0.6, 0.5, 0.05, -w
    RotatingStarsFull 0.8, 0.6, 0.05, -w
    RotatingStarsFull 0.65, 0.6, 0.05, -w
    RotatingStarsFull 0.7, 0.5, 0.05, -w
    RotatingStarsFull 0.9, 0.5, 0.05, -w
    RotatingStarsFull 0.8, 0.5, 0.05, -w
    RotatingStarsFull 0.8, 0.4, 0.05, -w
    RotatingStarsFull 0.8, 0.3, 0.05, -w
 
    _glFlush
END SUB
 
SUB IncrDrawPoint (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, s1 AS INTEGER, w AS SINGLE)
    STATIC s2 AS INTEGER
    IF s2 - s1 = 0 THEN s2 = 2 ELSE s2 = s2 + 1
    drawpoint x, y, r1, s2, 2 * s, w
END SUB
 
SUB IncrRotStarsvoid (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, w AS SINGLE)
    STATIC r2 AS SINGLE
    IF r2 >= r1 THEN r2 = 0 ELSE r2 = r2 + 0.001
    RotatingStarsVoid x, y, r2, w
END SUB
 
SUB drawpoint (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, s1 AS INTEGER, s2 AS SINGLE, w AS SINGLE)
    DIM i AS SINGLE, cx AS SINGLE, cy AS SINGLE
    _glColor4f 0.8, .8, 0.1, 1.0
    _glPointSize s1 ' it works with 2 or more !
    _glBegin _GL_POINTS
    FOR i = 0 TO _PI(2) STEP s2
        cx = (COS(i + w) * r1) + x
        cy = (SIN(i + w) * r1) + y
        _glVertex2f cx, cy
    NEXT i
    _glEnd
END SUB
 
 
 
 
SUB RotatingStarsFull (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, w AS SINGLE)
    DIM i, cx AS SINGLE, cy AS SINGLE, j AS INTEGER, k AS INTEGER, h AS INTEGER
    _glColor4f 0.8, .8, 0.1, 1.0
 
    _glBegin _GL_TRIANGLE_FAN
 
    h = 0
    FOR i = 0 TO _PI(2) STEP s
        h = h + 1
        IF h MOD 2 = 0 THEN
            j = 2: k = 1
        ELSE
            j = 1: k = 2
        END IF
 
        cx = (COS(i - s + w) * (r1 / k)) + x
        cy = (SIN(i - s + w) * (r1 / k)) + y
        _glVertex2f cx, cy
 
        cx = (COS(i + w) * (r1 / j)) + x
        cy = (SIN(i + w) * (r1 / j)) + y
        _glVertex2f cx, cy
        cx = (COS(i + s + w) * (r1 / k)) + x
        cy = (SIN(i + s + w) * (r1 / k)) + y
        _glVertex2f cx, cy
    NEXT i
 
    _glEnd
END SUB
 
SUB RotatingStarsVoid (x AS SINGLE, y AS SINGLE, r1 AS SINGLE, w AS SINGLE)
    DIM i, cx AS SINGLE, cy AS SINGLE, j AS INTEGER, k AS INTEGER, h AS INTEGER
    _glColor4f 0.8, 1, 0.1, 1.0
 
    _glBegin _GL_LINES
 
    h = 0
    FOR i = 0 TO _PI(2) STEP s
        h = h + 1
        IF h MOD 2 = 0 THEN
            j = 2: k = 1
        ELSE
            j = 1: k = 2
        END IF
 
 
        cx = (COS(i + w) * (r1 / j)) + x
        cy = (SIN(i + w) * (r1 / j)) + y
        _glVertex2f cx, cy
        cx = (COS(i + s + w) * (r1 / k)) + x
        cy = (SIN(i + s + w) * (r1 / k)) + y
        _glVertex2f cx, cy
    NEXT i
 
    _glEnd
END SUB
 

here a screenshot
[ This attachment cannot be displayed inline in 'Print Page' view ]

Merry Christmas and happy life!

PS all you have posted something of beautiful! Thanks to share these your works!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Aurel on December 27, 2020, 09:40:56 am

I must say that i like your snow-animation Sierraken ;

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Aurel on December 27, 2020, 09:46:51 am

Also well done Static ..i like it

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Pete on December 28, 2020, 02:18:08 am

So did I win? I bet I did. I posted the biggest app on the board. It's huge!!! If I didn't... it's rigged.

Pete

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: STxAxTIC on December 28, 2020, 02:21:25 am

Aw thanks Aurel!

My first fan art!... jkjk

Glad you liked it!

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: Dav on December 28, 2020, 09:54:27 am

I gotta say, that landscape thing you posted was pretty doggone awesome, @STxAxTIC. You could turn that into a flight simulator game.

- Dav

Title: Re: 🎄🎁✨ Holiday Season - are you ready to code?
Post by: STxAxTIC on December 28, 2020, 12:59:59 pm

Thanks much @Dav - it's been one of those back-burner projects spanning over a few years. I haven't decided on a proper endgame for this engine... Ditch particles and go with 3d triangles? Commit to particles and do something minecraft-like? If I could live several lifetimes, I would do both...

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: FellippeHeitor on December 06, 2020, 01:20:53 pm