Animated Christmas Cards

[B+]

Code: [Select]

_TITLE "Christmas Star Tree" 'B+  for QB64 2018-11-30

RANDOMIZE TIMER
CONST xmax = 1280
CONST ymax = 720
COMMON SHARED cN, pR, pG, Plasma AS _UNSIGNED LONG

'for Plasma writing
DIM SHARED maxIndex AS INTEGER
maxIndex = 3200
REDIM SHARED xyDat%(maxIndex, 1)
DIM SHARED cNw, pRw, pGw, pBw, indexP, DOTi
loadPlasmaData
resetPlasmaWrite

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 75, 5

'begin drawing background stars&
stars& = _NEWIMAGE(xmax, ymax, 32)
_DEST stars&
FOR i = 0 TO ymax - 80 ' sky
    LINE (0, i)-(xmax, i), _RGB32(50, 0, i / ymax * 68)
NEXT
FOR s = 1 TO 100 ' stars
    c = rand(155, 255)
    COLOR _RGBA32(c, c, c, RND * 100 + 155)
    fcirc RND * xmax, rand(0, 520), rand(0, 3)
NEXT
FOR i = ymax - 80 TO ymax 'ground
    LINE (0, i)-(xmax, i), _RGB32(50, 30, 20)
NEXT

' setup for main screen
_DEST 0
midx = 400
starCenterY = 30
maxd = ((ymax - starCenterY) ^ 2 + (midx - xmax) ^ 2) ^ .5
ofs = 0
dir = 1
DO WHILE _KEYDOWN(27) = 0 'main loop

    'update message
    _DEST stars&
    changePlasmaWrite
    DOTi = DOTi + 1
    IF DOTi <= indexP THEN fcirc xyDat%(DOTi, 0), xyDat%(DOTi, 1), 10

    'show update
    _DEST 0
    _PUTIMAGE , stars&, 0

    'main star over tree
    resetPlasma
    FOR a = 0 TO _PI(2) STEP _PI(1 / 36)
        IF a = 0 THEN
            lastx = midx + maxd * COS(a)
            lasty = starCenterY + maxd * SIN(a)
        ELSE
            x1 = midx + maxd * COS(a)
            y1 = starCenterY + maxd * SIN(a)
            changePlasma
            ftri midx, starCenterY, lastx, lasty, x1, y1, Plasma
            lastx = x1: lasty = y1
        END IF
    NEXT
    FOR R = 25 TO 0 STEP -1
        COLOR _RGBA(255, 255, 205, (25 - R) ^ 2 / 2.5)
        fcirc midx, starCenterY, R
    NEXT

    'tree
    stepper = stepper + dir
    IF stepper > 75 THEN dir = dir * -1: stepper = 75
    IF stepper < 14 THEN dir = dir * -1: stepper = 14
    FOR y = 80 TO ymax - 20 STEP stepper
        star midx, y, 5 + .1 * y, 15 + .5 * y, 6, ofs + _PI(y / 720)
    NEXT
    _DISPLAY
    ofs = ofs + _PI(1 / 36)
    IF ofs > _PI(2) THEN ofs = 0
    _LIMIT 8
LOOP

SUB changePlasma ()
    cN = cN + 1
    Plasma = _RGBA(200 + 56 * SIN(pR * cN), 200 + 56 * SIN(pG * cN), 128, RND * 64 + 30)
END SUB

SUB resetPlasma ()
    pR = RND ^ 2: pG = RND ^ 2
END SUB

SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB

SUB fatLine (x1, y1, x2, y2)
    stepx = x2 - x1: stepy = y2 - y1
    length = INT((stepx ^ 2 + stepy ^ 2) ^ .5)
    IF length THEN
        dx = stepx / length: dy = stepy / length
        FOR i = 0 TO length
            CIRCLE (x1 + dx * i, y1 + dy * i), 5
        NEXT
    END IF
END SUB

SUB star (x, y, rInner, rOuter, nPoints, angleOffset)
    ' x, y are same as for circle,
    ' rInner is center circle radius
    ' rOuter is the outer most point of star
    ' nPoints is the number of points,
    ' angleOffset = angle offset in radians
    ' this is to allow us to spin the star

    'modified a bit for stacking up a tree

    DIM ar(INT(nPoints) * 4 + 3) 'add two for origin
    pAngle = _PI(2) / nPoints: radAngleOffset = angleOffset - _PI(1 / 2)
    x1 = x + rOuter * COS(radAngleOffset)
    y1 = y + .2 * rOuter * SIN(radAngleOffset)
    idx = 4
    FOR i = 0 TO nPoints - 1
        x2 = x + rInner * COS(i * pAngle + radAngleOffset + .5 * pAngle)
        y2 = y + .2 * rInner * SIN(i * pAngle + radAngleOffset + .5 * pAngle)
        COLOR _RGB32(rand(0, 40), rand(40, 120), rand(0, 35))
        fatLine x1, y1, x2, y2
        x1 = x2
        y1 = y2
        x2 = x + rOuter * COS((i + 1) * pAngle + radAngleOffset)
        y2 = y + .2 * rOuter * SIN((i + 1) * pAngle + radAngleOffset)
        COLOR _RGB32(rand(0, 40), rand(40, 120), rand(0, 35))
        fatLine x1, y1, x2, y2
        x1 = x2
        y1 = y2
    NEXT
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , 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), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB

'separatePlasma for writing than main star
SUB changePlasmaWrite ()
    cNw = cNw + .5
    COLOR _RGB(127 + 127 * SIN(pRw * cNw), 127 + 127 * SIN(pGw * cNw), 127 + 127 * SIN(pBw * cNw))
END SUB

SUB resetPlasmaWrite ()
    pRw = RND ^ 2: pGw = RND ^ 2: pBw = RND ^ 2
END SUB

SUB loadPlasmaData
    indexP = 0
    WHILE dx <> 9999
        READ dx, dy
        IF dx <> 9999 THEN xyDat%(indexP, 0) = dx: xyDat%(indexP, 1) = dy: indexP = indexP + 1
    WEND
END SUB

DATA 877,65,877,65,877,65,877,65,877,65,877,67,877,70,877,74,877,79,878,85
DATA 878,89,878,95,879,100,881,105,881,111,881,116,882,120,882,122,883,126,883,131
DATA 883,135,883,140,883,144,883,148,883,153,883,159,883,164,883,166,883,177,883,179
DATA 883,183,883,188,884,191,884,194,884,197,884,201,884,203,884,205,884,207,884,208
DATA 884,210,884,211,883,211,883,211,878,211,874,211,859,210,853,210,843,210,840,210
DATA 828,211,824,211,817,211,806,210,799,209,797,208,795,207,795,207,795,207,795,207
DATA 795,207,795,207,795,207,795,207,795,207,795,207,795,207,795,207,795,207,795,207
DATA 795,207,795,207,795,207,795,207,943,154,942,154,940,156,938,159,937,162,936,164
DATA 935,167,935,170,934,173,934,174,934,177,934,179,934,183,935,186,937,189,937,192
DATA 938,195,939,197,939,199,940,200,940,201,941,202,941,203,942,203,943,203,943,204
DATA 944,204,945,204,945,204,948,205,949,205,952,206,956,206,962,206,966,206,968,205
DATA 969,205,970,203,972,201,974,200,976,199,978,198,978,197,979,196,980,194,980,192
DATA 980,190,980,186,980,183,980,182,980,181,980,180,980,179,980,178,980,177,978,175
DATA 977,173,975,171,974,169,971,167,970,166,968,165,968,165,968,165,968,164,968,164
DATA 967,164,965,163,963,163,962,162,962,161,961,161,961,161,961,161,960,161,960,161
DATA 960,161,960,161,960,161,960,161,960,161,960,161,960,161,960,161,960,161,960,161
DATA 960,161,960,161,960,161,960,161,960,161,960,161,960,161,960,161,960,161,1020,159
DATA 1020,159,1020,159,1020,159,1020,159,1020,159,1020,162,1020,166,1021,172,1022,173,1024,178
DATA 1026,180,1027,185,1028,188,1029,190,1030,192,1031,193,1031,195,1032,196,1033,197,1034,199
DATA 1034,201,1036,203,1036,204,1037,205,1037,205,1037,205,1037,205,1037,205,1037,205,1037,205
DATA 1037,205,1037,205,1037,205,1037,205,1037,205,1037,205,1037,205,1037,205,1037,205,1037,205
DATA 1037,205,1037,205,1037,205,1037,205,1038,205,1038,204,1039,203,1040,200,1040,198,1041,195
DATA 1042,192,1043,188,1044,187,1046,181,1046,180,1047,176,1047,175,1049,171,1051,169,1051,168
DATA 1052,167,1052,166,1052,165,1053,164,1053,164,1053,163,1054,162,1055,161,1055,160,1055,159
DATA 1055,158,1055,157,1056,157,1056,156,1056,155,1056,154,1056,154,1057,153,1057,153,1057,153
DATA 1057,153,1057,153,1057,153,1057,153,1057,153,1057,153,1057,153,1057,153,1057,153,1036,204
DATA 1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204
DATA 1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204
DATA 1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204,1036,204
DATA 1036,204,1036,204,1036,204,1035,207,1035,209,1035,211,1035,214,1034,218,1034,221,1033,225
DATA 1032,229,1031,234,1030,237,1029,241,1028,243,1028,245,1028,246,1027,247,1026,249,1026,250
DATA 1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251
DATA 1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251
DATA 1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251,1026,251
DATA 1026,251,1026,251,1025,252,1024,254,1024,256,1024,257,1024,257,1024,257,1024,257,1024,257
DATA 1024,257,1024,257,1024,257,1024,257,1024,257,1024,257,1024,257,1024,257,1024,257,1024,257
DATA 1024,257,1024,257,843,318,843,318,843,318,843,318,843,318,843,318,843,318,843,318
DATA 843,319,843,319,844,323,845,325,845,334,846,341,846,350,847,363,848,375,848,387
DATA 849,400,850,405,850,408,851,411,851,413,851,414,851,414,851,414,851,414,851,414
DATA 851,414,851,414,851,416,851,416,851,416,851,416,851,416,851,416,831,375,831,375
DATA 831,375,831,375,831,375,831,375,831,375,831,375,832,375,835,375,850,375,866,375
DATA 883,375,891,375,894,375,898,375,899,375,899,375,899,375,899,375,900,375,900,375
DATA 900,375,900,375,900,375,900,375,900,375,900,375,900,375,900,375,931,374,931,374
DATA 931,374,928,377,927,380,924,384,922,387,921,389,921,391,921,394,921,394,923,397
DATA 924,398,924,399,925,400,927,402,928,404,929,405,930,406,930,407,930,407,930,407
DATA 931,407,931,407,933,407,941,405,944,404,946,402,947,401,948,399,948,398,948,397
DATA 948,397,949,395,949,394,949,393,949,392,949,391,949,390,949,389,949,388,949,387
DATA 949,385,949,383,949,383,949,381,948,380,947,380,947,380,947,380,947,380,947,380
DATA 947,380,947,380,947,380,947,380,947,380,947,380,947,380,947,380,947,380,1023,303
DATA 1023,303,1023,303,1022,306,1022,309,1022,314,1022,318,1023,323,1024,332,1025,341,1026,350
DATA 1026,356,1026,361,1027,369,1028,371,1028,373,1028,375,1028,377,1028,380,1028,383,1028,386
DATA 1028,388,1028,391,1028,392,1028,393,1029,393,1029,393,1029,393,1029,393,1029,393,1029,393
DATA 1029,393,1029,393,1029,393,1029,393,1029,393,1029,393,1029,393,1029,395,1029,397,1030,398
DATA 1030,398,1030,398,1030,398,1030,398,1030,398,1030,400,1030,401,1030,403,1030,404,1030,404
DATA 1030,404,1030,404,1030,404,1030,405,1030,405,1030,405,1030,405,1030,405,1030,405,1030,405
DATA 997,352,997,352,997,352,997,352,997,352,997,352,997,352,997,352,997,352,998,352
DATA 1003,352,1011,353,1023,353,1028,352,1030,351,1031,351,1031,351,1031,351,1031,351,1031,351
DATA 1031,351,1031,351,1031,351,1031,351,1031,351,1031,351,1031,351,1032,351,1032,351,1032,351
DATA 1032,351,1032,351,1032,351,1032,351,1032,351,1032,351,1032,351,1032,351,1032,351,1032,351
DATA 1032,351,1032,351,1032,351,1032,351,1032,351,1032,351,1032,351,1032,351,1033,351,1035,351
DATA 1036,350,1037,350,1037,350,1037,350,1038,350,1039,350,1040,350,1041,349,1042,349,1042,349
DATA 1042,349,1042,349,1042,349,1042,349,1042,349,1042,349,1042,349,1042,349,1059,296,1059,296
DATA 1059,296,1059,296,1059,296,1059,296,1059,298,1059,302,1059,305,1059,314,1059,321,1059,327
DATA 1059,333,1059,338,1059,343,1059,347,1059,351,1060,358,1060,364,1060,371,1060,378,1060,384
DATA 1061,389,1061,392,1061,396,1061,398,1062,402,1062,404,1062,404,1062,405,1062,405,1062,405
DATA 1062,405,1062,405,1062,405,1062,405,1062,405,1062,405,1062,405,1062,405,1062,405,1062,405
DATA 1062,405,1062,405,1062,405,1062,405,1062,399,1063,395,1063,391,1064,386,1064,383,1065,376
DATA 1066,370,1067,365,1069,361,1070,358,1072,354,1073,352,1074,351,1074,350,1075,349,1076,349
DATA 1077,348,1078,348,1079,348,1080,348,1081,348,1081,347,1081,347,1081,347,1081,347,1081,349
DATA 1083,352,1085,356,1087,361,1089,367,1090,369,1092,376,1094,378,1094,380,1094,381,1095,384
DATA 1095,386,1095,387,1095,388,1095,389,1095,389,1095,389,1095,389,1095,389,1095,389,1095,389
DATA 1095,389,1095,389,1095,389,1095,389,1095,389,1095,389,1096,391,1096,392,1096,392,1096,393
DATA 1097,393,1098,396,1099,397,1099,397,1099,398,1099,398,1099,398,1099,398,1099,398,1099,398
DATA 1099,398,1099,398,1099,398,1099,398,1099,398,1106,366,1106,366,1106,366,1106,366,1106,366
DATA 1106,366,1106,366,1106,366,1106,366,1106,366,1106,366,1106,366,1106,366,1106,366,1106,366
DATA 1106,366,1110,365,1111,364,1115,364,1118,363,1123,362,1124,362,1125,362,1126,362,1129,361
DATA 1133,360,1137,359,1141,357,1142,356,1142,356,1143,356,1143,354,1144,353,1145,352,1146,350
DATA 1146,349,1146,348,1146,347,1146,347,1146,347,1146,347,1146,347,1146,347,1146,347,1145,346
DATA 1141,345,1138,344,1137,344,1135,344,1134,344,1132,344,1129,346,1126,347,1122,348,1119,350
DATA 1117,351,1117,352,1116,353,1113,357,1111,360,1110,363,1109,366,1108,368,1107,372,1106,377
DATA 1106,378,1106,382,1106,384,1106,386,1106,388,1106,389,1106,390,1108,390,1108,391,1109,391
DATA 1114,392,1120,393,1129,393,1139,393,1147,393,1152,392,1158,391,1163,389,1164,389,1169,386
DATA 1172,385,1175,383,1176,383,1177,381,1177,381,1177,381,1177,381,1177,381,1177,381,1177,381
DATA 1177,381,1177,381,1177,381,1177,381,1177,381,1177,381,1177,381,1177,381,797,495,797,495
DATA 797,495,797,495,797,495,797,495,797,495,797,495,797,495,797,499,800,507,802,517
DATA 804,526,811,542,816,554,820,563,822,569,825,575,826,581,827,583,828,590,829,595
DATA 830,598,831,602,832,608,832,609,834,614,834,618,835,620,837,623,838,624,838,624
DATA 840,624,841,619,843,613,845,607,847,601,849,595,852,585,854,580,856,575,858,570
DATA 859,564,861,560,864,552,865,548,866,544,867,540,869,534,870,529,873,522,873,516
DATA 876,509,877,503,878,500,879,498,879,496,879,496,879,496,879,496,879,496,879,496
DATA 879,496,879,496,879,496,879,496,879,496,879,496,879,496,880,500,881,507,883,516
DATA 884,527,885,538,889,550,891,557,892,562,894,568,894,569,896,575,896,576,896,580
DATA 897,581,898,585,898,587,900,590,902,594,904,596,906,599,907,600,908,601,909,602
DATA 911,604,911,606,912,606,912,606,912,606,913,606,913,606,913,606,913,606,913,606
DATA 914,606,914,606,915,606,915,606,916,606,916,606,916,606,917,606,917,606,918,607
DATA 920,609,920,610,920,610,920,610,920,610,920,610,920,610,921,610,921,610,921,609
DATA 924,600,925,595,926,588,927,581,928,573,930,565,931,550,932,538,932,530,933,522
DATA 934,515,936,509,936,506,936,504,936,503,937,502,937,501,937,500,937,499,937,498
DATA 937,498,937,498,937,498,937,498,937,498,937,498,937,498,937,498,937,498,937,498
DATA 937,498,937,498,937,498,937,498,937,498,989,563,989,563,988,562,988,562,987,562
DATA 985,562,983,563,981,564,977,569,975,572,973,573,970,577,968,582,967,585,966,588
DATA 966,590,966,593,966,596,966,599,967,601,968,603,969,605,971,607,972,609,974,612
DATA 975,614,976,615,977,615,977,615,977,615,977,615,980,613,985,609,989,606,992,603
DATA 994,600,994,599,997,596,997,594,999,591,1000,590,1001,587,1003,584,1004,582,1004,580
DATA 1005,579,1005,577,1005,574,1005,573,1005,571,1005,570,1005,569,1005,568,1005,568,1005,567
DATA 1005,566,1005,566,1004,566,1004,566,1004,566,1004,566,1003,563,999,561,998,560,998,560
DATA 998,560,998,560,998,560,998,560,998,560,998,560,1028,562,1028,562,1028,562,1028,562
DATA 1027,562,1027,563,1027,564,1026,566,1026,567,1026,571,1026,574,1028,581,1030,585,1033,590
DATA 1035,594,1036,597,1037,599,1038,600,1038,600,1038,600,1038,600,1038,600,1038,600,1038,600
DATA 1038,600,1038,600,1038,599,1038,599,1038,599,1038,599,1038,597,1037,591,1036,589,1035,583
DATA 1035,581,1034,577,1034,575,1034,572,1034,568,1034,566,1034,564,1034,563,1034,561,1034,560
DATA 1035,560,1036,559,1037,558,1037,558,1037,558,1037,558,1037,558,1038,558,1038,557,1038,557
DATA 1041,557,1043,556,1044,555,1044,555,1044,555,1044,555,1044,555,1044,555,1044,555,1044,555
DATA 1044,555,1044,555,1044,555,1071,499,1071,499,1071,499,1071,499,1071,499,1071,507,1071,512
DATA 1071,518,1071,525,1071,532,1071,539,1072,546,1074,554,1074,561,1075,566,1077,574,1078,580
DATA 1079,585,1080,588,1080,590,1081,593,1081,593,1081,594,1081,594,1081,594,1081,594,1081,594
DATA 1081,596,1082,597,1082,599,1082,600,1082,601,1083,602,1083,603,1083,603,1083,603,1083,603
DATA 1083,603,1083,604,1083,605,1084,605,1084,605,1084,605,1084,605,1084,605,1159,563,1159,563
DATA 1158,563,1158,563,1155,561,1153,560,1148,559,1147,559,1139,559,1135,559,1132,560,1131,561
DATA 1130,562,1129,565,1128,567,1127,569,1127,573,1126,576,1126,580,1126,583,1125,587,1125,591
DATA 1125,595,1126,601,1128,604,1130,605,1132,607,1133,609,1136,611,1138,612,1139,612,1140,612
DATA 1145,609,1151,603,1155,601,1158,598,1161,595,1164,594,1166,592,1167,589,1169,585,1171,581
DATA 1172,576,1172,573,1172,570,1172,568,1172,564,1172,561,1172,558,1171,554,1170,548,1170,542
DATA 1170,537,1170,531,1169,526,1169,521,1168,517,1167,509,1167,505,1167,502,1167,497,1167,493
DATA 1167,491,1167,489,1167,487,1167,487,1167,487,1167,486,1167,485,1167,484,1167,482,1167,480
DATA 1167,479,1167,477,1167,476,1167,475,1167,475,1167,475,1167,475,1167,475,1167,475,1167,475
DATA 1167,475,1167,475,1167,475,1167,476,1167,480,1167,487,1167,492,1168,497,1169,505,1170,511
DATA 1171,518,1174,524,1176,536,1177,542,1178,548,1180,553,1181,558,1182,562,1183,567,1184,572
DATA 1185,577,1187,584,1188,589,1189,592,1190,595,1190,598,1191,601,1191,603,1192,604,1192,605
DATA 1193,606,1193,607,1194,608,1194,609,1194,609,1195,611,1195,611,1195,612,1195,613,1196,613
DATA 1196,613,1196,613,1196,613,1196,613,1196,613,1196,613,1196,613,1196,613,1196,613,1196,613
DATA 1196,613,1196,613,1196,613,1196,613,1196,613,1196,613,1131,51,1131,51,1131,51,1131,51
DATA 1131,51,1131,51,1131,52,1131,56,1131,61,1131,71,1131,79,1131,89,1131,97,1130,106
DATA 1130,112,1130,117,1130,122,1130,122,1130,129,1130,131,1130,134,1129,136,1129,141,1128,147
DATA 1127,160,1126,164,1126,174,1126,180,1126,183,1126,183,1126,183,1125,183,1125,183,1125,183
DATA 1125,183,1125,183,1125,183,1125,183,1125,183,1125,183,1125,183,1125,183,1125,183,1125,183
DATA 1118,232,1118,232,1118,232,1118,232,1118,232,1118,232,1118,232,1118,232,1118,232,1118,232
DATA 1118,232
DATA 9999,9999



[Mike Lobanovsky]

The attached animated Xmas card was originally written by Peter Wirbelauer (not sure if he's still a member here) for his GDI sprite library implemented in OxygenBasic.

FBSL has its strongest point in being able to follow the low level Windows SDK programming style in BASIC code but wrapping the WinAPI's in higher level macros (simplified GUI, gfx primitives, sprites, extra resolution timers, music and video) in an 85 liner mingfx.inc include file enabled me to emulate his coding style and semantics almost 1:1. Probably the same or similar things can also be done in other kiddie BASIC implementations.

The attached zip contains a precompiled executable (just unblock and ignore false AV alarms) and the assets to run it.

The FBSL code is as follows:

Code: [Select]

#Option Implicit
#Include "mingfx.inc"

width = 800
height = 600
w = 11: h = 11
flakes = width

wallpaper = LoadSprite("xmas.bmp", width, height, 1)
snowflake = LoadSprite("snowflake.gif", w, h, 1)

Type PARTICLE
  !x !y
  !speed
  !angle
End Type

Dim !x, !y, !s, !a, snow[flakes] As PARTICLE
For flakes = 0 To width
  snow[flakes].x = Rnd() * width
  snow[flakes].y = Rnd() * height - height
  snow[flakes].speed = Rnd() * w / 4 + w / 4
  snow[flakes].angle = Rnd() * h + h * h
Next

Window(width, height, FALSE, "Peter's Greets")

Screen(220, 210, 250)
Ink(255, 255, 0)

Animate
  DrawSprite(wallpaper, 0, 0, width, height, 0)
  For flakes = 0 To width
    @x = @snow[flakes].x: @y = @snow[flakes].y
    @s = @snow[flakes].speed: @a = @snow[flakes].angle
   
    x = x + Cos(a) * s: y = y + Sin(a) * s
    DrawSprite(snowflake, x + Cos * s, y + y + Sin * s, w, h, 0)
   
    If y > Rnd() * height / 3 + height / 2 Then
      x = Rnd() * width: y = -h
    End If
    If x < 0 Then x = width Else If x > width Then x = 0
  Next
  Message(200,20, 20, "MERRY CHRISTMAS!", Ink)
  Redraw()
  Wait(10)
Forever

[B+]

Hi Mike,

Thanks for sharing. Is Peter W also known as PeterMaria (whom I knew at SdlBasic forum for awhile)?

SdlBasic sample:

Code: [Select]


'Plasma Mystery by PeterMaria   2016-06-16 copy
option Qbasic

setdisplay(400,400,32,1)
autoback(0)

sub plasma(im, ii, st)
   dim fx, fy, i, c
   for x=0 to 400
   i =1
   fy=0
   for y=0 to 400
       c = i*cos(fx)+i*sin(fy)/8
       plot(x, y, c)
  i=i*im+ii
       fy = fy+st
   next
   fx = fx+st
   next
end sub

dim m, n

while key(27)=0
m=1.0
n=1.0
for i=1 to 120
    plasma(m,n,0.02)
    n=n+111
    screenswap
next

m=1.0
n=1.0
for i=1 to 120
    plasma(m,n,0.05)
    n=n+111
    screenswap
next

m=1.0
n=1.0
for i=1 to 120
    plasma(m,n,0.015)
    n=n+111
    screenswap
next
wend


Oh yeah, he was at one of Aurel's forums for awhile too. Like Aurel, he was O2 fan which is why I think it was same Peter.

Append: Also I think I can size the flakes and create a 3d effect with snow.

[B+]

Yeah add snow to any scene:

Code: [Select]

_TITLE "Snowjob, a B+ mod" 'from Mike's mod of Peter W, to QB64 copied and B+ mod 2018-12-5
' Cyber font.bmp from Cybermonkey at Walter's forum RIP
' 2018-12-05 repost with better math

CONST XMAX = 800
CONST YMAX = 600

' background pick an image
wallpaper& = _LOADIMAGE("xmas.bmp", 32)
wallpaper& = _LOADIMAGE("xmas1.jpg", 32)
'wallpaper& = _LOADIMAGE("snow1.jpg", 32)

'flake
snowflake& = _LOADIMAGE("snowflake.gif", 32)
FOR i = 0 TO 50
    _CLEARCOLOR _RGB32(i, i, i), snowflake&
NEXT

'cyber font
DIM SHARED cf&, cfW, cfH
cf& = _LOADIMAGE("Cyber font.bmp", 32)
cfW = 40
cfH = 34

'snow making machine
TYPE PARTICLE
    x AS SINGLE
    y AS SINGLE
    size AS SINGLE
    speed AS SINGLE
    angle AS SINGLE
    maxy AS SINGLE
END TYPE
nLayers = 11
flakes = 2 ^ (nLayers + 1) - 1
DIM snow(flakes) AS PARTICLE

FOR layer = nLayers TO 0 STEP -1
    FOR flake = 0 TO 2 ^ layer
        snow(flake).x = RND * XMAX
        snow(flake).y = RND * YMAX - YMAX
        snow(flake).size = nLayers - layer
        snow(flake).speed = .1 * (nLayers - layer)
        snow(flake).angle = RND * (_PI - _PI(1 / 6)) + _PI(1 / 12)
        snow(flake).maxy = .5 * YMAX + (nLayers - layer) * (.5 * YMAX / nLayers)
    NEXT
NEXT

SCREEN _NEWIMAGE(XMAX, YMAX, 32)
_SCREENMOVE 200, 100
DO
    _PUTIMAGE , wallpaper&, 0
    FOR flake = flakes TO 0 STEP -1
        snow(flake).x = snow(flake).x + COS(snow(flake).angle) * snow(flake).speed + RND * 2 - .75
        snow(flake).y = snow(flake).y + SIN(snow(flake).angle) * snow(flake).speed + RND * 2 - .5
        _PUTIMAGE (snow(flake).x, snow(flake).y)-STEP(snow(flake).size, snow(flake).size), snowflake&, 0

        IF snow(flake).y > snow(flake).maxy THEN
            snow(flake).x = RND * XMAX: snow(flake).y = RND * YMAX - 1.1 * YMAX
        END IF
        IF snow(flake).x < 0 THEN
            snow(flake).x = XMAX
        ELSEIF snow(flake).x > XMAX THEN
            snow(flake).x = 0
        END IF
    NEXT
    'LINE (180, YMAX - 65)-STEP(420, 50), _RGBA32(128, 0, 0, 180), BF
    cfMessage "MERRY CHRISTMAS!", 200, YMAX - 60, 400, 40 'Cybermonkey's font
    _DISPLAY
    _LIMIT 60
LOOP

SUB cfMessage (message$, xBox, yBox, wBox, hBox)
    lm = LEN(message$)
    bm = .125 * hBox
    px = lm * (cfW + bm) + 2 * bm
    py = cfH + 2 * bm
    xScale = wBox / px
    yScale = hBox / py
    FOR i = 1 TO LEN(message$)
        c$ = MID$(message$, i, 1)
        cfLetter c$, xBox + (i - 1) * (cfW + bm) * xScale + bm, yBox + bm, xScale, yScale
    NEXT
END SUB

SUB cfLetter (L$, x, y, xScale, yScale)
    _CLEARCOLOR _RGB32(0, 0, 0), cf&
    lNum = INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ!'()-.?:0123456789, ", UCASE$(L$))
    IF lNum = 0 THEN EXIT SUB ' couldn't find it
    lNum = lNum - 1
    lRow = lNum \ 8 '5 + rows
    lCol = lNum MOD 8 '8 chars per row
    lW = 40
    lH = 34
    _PUTIMAGE (x, y)-STEP(lW * xScale, lH * yScale), cf&, 0, (lCol * lW, lRow * lH)-STEP(lW - 1, lH - 1)
END SUB

EDIT: oops got some numbers backwards, reposting with corrections

[B+]

Repost: other images with snow machine

[Mike Lobanovsky]

Is Peter W also known as PeterMaria (whom I knew at SdlBasic forum for awhile)?

Yep, I guess that would be him. He used to have difficulty expressing himself in English but his code was mostly fun and spake for itself, even though his libraries were closed-source and certainly needed some experience to be reproduced/reverse engineered in other BASIC flavors from scratch. I think he also used to be a member of the old BP dot org before his wife passed away and he ceased socializing on the forums.

Your colorful and grayscale snow-blow jobs look real nice. I'm not planning on running your QB64 code myself (got practically no spare time for hobbies lately). Just tell me if your snowflake velocity and direction randomization resembles Peter's visually? I find his version very neat in this respect and closely resembling what real snow would look like blown by some sideways wind.

[B+]

Yes I preserved the method of updating the X and Y position of the flake adding a little more random walking so flakes "feel" light and fluffy with a slight tendency to drift right while floating down.

Oops, now I realize I need to start them wider than width of screen for this tendency, the bottom left corner will have tendency to be empty. I also want to melt them into landing spot because then look bubbles popping and rotate them randomly to distinguish more from stars. Trying drawn flakes instead of image.

[Mike Lobanovsky]

Your flakes look really cool!

And if you look closely at my animation, you'll also notice that the flakes are leaving sort of grayish buildup on top of snowy white "surfaces" they're flying over. Very realistic, I'd say. But it's just a side effect of blending several sprite transparencies on top of one another. I could've gotten rid of it easily but decided against it -- I like it better this way.



Here comes another very very cool Xmas card/quest created by a Joseph E. in Liberty BASIC quite a while ago. I believe you can still find his original LB code at their forum.

I came across it 6 years ago and ported it to FBSL BASIC recreating LB's sprite system, animation scripting, and sound in the process just by looking at Joseph's code and reading their help manual. That was quite fun to do. You can look into the animation scripts and see that they are 100% original as used by the poor fellows that paid their hard earned $$$ to buy that piece of utter bloatware.

The only difference with the original is that I'm using .GIFs instead of lossless .BMPs/.PNGs/.TGAs/.TIFs to meet the archive size allowed here, even though it impairs the quality of sprites. In fact, I have a special Russian build of this app with double sized wallpapers and hi-res sprites that used to be very popular with my grands a few years ago.

The entire app script is a 1K liner included for reference. Those who still have an installation of at least FBSL v3.5 RC1 can run it from the Eclecta editor, and those who haven't can download the zip, unblock it, and run the precompiled executable ignoring false AV alarms.

Make sure your audio gear is turned on and both MIDI and WAV audio/MP3 channels are made equally audible because the app uses rich stereo sound mixed asynchronously in both channels.

Enjoy!

[B+]

Ho, Ho! very nice!

I saw a mouse in assets and said, "Wait, I didn't see that used." Went back and ran it again and found a whole bunch of other things happening. Fun!