Recent Posts

Pages: [1] 2 3 ... 10
1
Programs / Re: eRATication
« Last post by Cobalt on Yesterday at 02:36:44 PM »
so here is a preview release of the MODed version of Bplus's eRATication game.
Still some work to do but, it gives you an idea of the feel I'm going for.
probably start new thread when Its completed.

Code: [Select]
'eRATication by Bplus 2018-07-15
'Ultra Mod version by Cobalt 2018-07-19 13:25 Build 0001 Ver 1.0beta

'known things to fix/complete:
'   re-add rat collision with player
'    À-Currently in GOD mode. :)
'   add Title screen and Title Bar text
'   fix bullet collision with rat so Mini rats are hit correctly
'    À-add more points of detection shots tend to pass right by :(
'   add highscore list
'   re-add hit explosions
'    À-rats simply vanish at the moment :(

TYPE RatData
 Xloc AS SINGLE 'X location
 Yloc AS SINGLE 'Y location
 Siz AS INTEGER 'Size(radius)
 Rot AS SINGLE 'Rotation(heading)
 Spd AS SINGLE 'Speed
 Colr AS _UNSIGNED LONG 'color of rat
 Val AS _UNSIGNED _BYTE 'score value of rat
END TYPE

TYPE Bulletdata
 Xloc AS SINGLE 'locations
 Yloc AS SINGLE
 DXval AS SINGLE 'movement values
 DYval AS SINGLE
 RemFlag AS _BYTE 'if the shot has hit a rat or gone offscreen flag for removal
END TYPE

TYPE PlayerData
 Rot AS SINGLE
 Xloc AS SINGLE
 Yloc AS SINGLE
 Life AS _BYTE
 Points AS _UNSIGNED LONG
 walk AS SINGLE '???
 Momentum AS SINGLE 'players movement speed
 ThrstRot AS SINGLE 'the rotation of players craft when thrust was stopped
END TYPE

'constants
CONST ScrnX = 800
CONST ScrnY = 600

CONST MaxRats = 100
CONST MaxBullets = 25
CONST MaxShots = 3 'only 3 shots at a time on screen
CONST BulletSpeed = 20
CONST RatScore = 71 'how much the base score of each rat is
CONST Drag = .015 'how much the players movement slows over time
CONST Rate = .25 'delay between shots fired
CONST RatCount = 5 'base rat count
CONST TRUE = -1, FALSE = NOT TRUE

'Make screen and set timer
SCREEN _NEWIMAGE(ScrnX, ScrnY, 32)
RANDOMIZE TIMER

'set up arrays
DIM SHARED P AS PlayerData
DIM SHARED Rats(MaxRats) AS RatData
DIM SHARED Shot(MaxBullets) AS Bulletdata

'set up layers, an idea for haveing everything on its own layer then
'combining them on to the display
'DIM SHARED shiplayer&, ratlayer&
'shiplayer& = _NEWIMAGE(ScrnX, ScrnY, 32)
'ratlayer& = _NEWIMAGE(ScrnX, ScrnY, 32)

'initilize starting Values
ShotsFired%% = 0 'number of shots fired
P.Life = 1 'player on life #1
P.Points = 0
P.Rot = 0
P.Xloc = ScrnX \ 2
P.Yloc = ScrnY \ 2

'make some Rats
FOR i%% = 0 TO RatCount - 1
 newRat i%%
NEXT
'OPEN "debug.txt" FOR OUTPUT AS #1
DO
 CLS
 walk = (walk + 1) MOD 2
 FOR i = 1 TO P.Life * RatCount 'the rats
  drawRat i
 NEXT

 'use arrow keys to swing shooter, spacebar to fire
 'left shift to speed up rotation, this frees up the UP arrow to allow for movement
 'of the players craft.
 IF _KEYDOWN(100304) THEN speed%% = 20 ELSE speed%% = 60
 IF _KEYDOWN(19200) THEN P.Rot = P.Rot - _PI(1 / speed%%)
 IF _KEYDOWN(19712) THEN P.Rot = P.Rot + _PI(1 / speed%%)

 IF _KEYDOWN(18432) THEN 'up arrow provides thrust!
  P.Momentum = P.Momentum + .056
  IF P.Momentum > 2.86 THEN P.Momentum = 2.86
  P.ThrstRot = P.Rot 'get current rotation
 ELSEIF P.Momentum THEN 'player is no longer thrusting and still has momentum
  P.Momentum = P.Momentum - Drag
  IF P.Momentum < 0 THEN P.Momentum = 0
 END IF

 ' IF _KEYDOWN(20480) THEN P.Rot = P.Rot + _PI(1 / 30)
 'added cooldown to shooting so you can't auto gun 'normally' maybe add specails
 'or bonuses to allow that later
 IF _KEYDOWN(32) AND ShotsFired%% < MaxShots AND cooldown! + Rate < TIMER THEN
  ShotsFired%% = NewShot(ShotsFired%%): cooldown! = TIMER
 ELSE
 END IF

 IF ShotsFired%% THEN ShotsFired%% = shotprocess(ShotsFired%%)
 PlayerMovement
 drawshooter P.Xloc, P.Yloc, P.Rot

 IF P.Life > 3 THEN ExitFlag%% = TRUE
 IF INKEY$ = CHR$(27) THEN ExitFlag%% = TRUE

 LOCATE 1, 1: PRINT "Life:"; P.Life; TAB(10); "Points:";
 PRINT USING "#,###,###"; P.Points

 _DELAY .05
LOOP UNTIL ExitFlag%%


SUB newRat (iRat)
 'bring rock in from one side, need to set heading according to side
 'RANDOMIZE TIMER + RND
 side%% = INT(RND * 4) + 1
 SELECT CASE side%%
  CASE 1: Rats(iRat).Xloc = 0: Rats(iRat).Yloc = RND * ScrnY: Rats(iRat).Rot = 3 * _PI / 2 + RND * _PI
  CASE 2: Rats(iRat).Xloc = ScrnX: Rats(iRat).Yloc = RND * ScrnY: Rats(iRat).Rot = _PI / 2 + RND * _PI
  CASE 3: Rats(iRat).Xloc = RND * ScrnX: Rats(iRat).Yloc = 0: Rats(iRat).Rot = RND * _PI
  CASE 4: Rats(iRat).Xloc = RND * ScrnX: Rats(iRat).Yloc = ScrnY: Rats(iRat).Rot = _PI + RND * _PI
 END SELECT
 
 'speed, angle, radius, gray coloring, spin, seed
 Rats(iRat).Spd = RND * 5 * P.Life + 1
 Rats(iRat).Siz = RND * 60 / P.Life + 3
 Rats(iRat).Colr = ratKolor~&
END SUB

SUB drawRat (i)
 'move the rat
 Rats(i).Xloc = Rats(i).Xloc + Rats(i).Spd * COS(Rats(i).Rot) + rand(-.1 * Rats(i).Siz, .1 * Rats(i).Siz)
 Rats(i).Yloc = Rats(i).Yloc + Rats(i).Spd * SIN(Rats(i).Rot) + rand(-.1 * Rats(i).Siz, .1 * Rats(i).Siz)

 IF Rats(i).Xloc > 0 AND Rats(i).Xloc < ScrnX AND Rats(i).Yloc > 0 AND Rats(i).Yloc < ScrnY THEN 'inbounds
  noseX = Rats(i).Xloc + 2 * Rats(i).Siz * COS(Rats(i).Rot)
  noseY = Rats(i).Yloc + 2 * Rats(i).Siz * SIN(Rats(i).Rot)
  neckX = Rats(i).Xloc + .75 * Rats(i).Siz * COS(Rats(i).Rot)
  neckY = Rats(i).Yloc + .75 * Rats(i).Siz * SIN(Rats(i).Rot)
  tailX = Rats(i).Xloc + 2 * Rats(i).Siz * COS(Rats(i).Rot + _PI)
  tailY = Rats(i).Yloc + 2 * Rats(i).Siz * SIN(Rats(i).Rot + _PI)
  earLX = Rats(i).Xloc + Rats(i).Siz * COS(Rats(i).Rot - _PI(1 / 12))
  earLY = Rats(i).Yloc + Rats(i).Siz * SIN(Rats(i).Rot - _PI(1 / 12))
  earats.sizats.xloc = Rats(i).Xloc + Rats(i).Siz * COS(Rats(i).Rot + _PI(1 / 12))
  earats.sizats.yloc = Rats(i).Yloc + Rats(i).Siz * SIN(Rats(i).Rot + _PI(1 / 12))
  fcirc Rats(i).Xloc, Rats(i).Yloc, .65 * Rats(i).Siz, Rats(i).Colr
  fcirc neckX, neckY, Rats(i).Siz * .3, Rats(i).Colr
  fTri noseX, noseY, earLX, earLY, earats.sizats.xloc, earats.sizats.yloc, Rats(i).Colr
  fcirc earLX, earLY, Rats(i).Siz * .3, Rats(i).Colr
  fcirc earats.sizats.xloc, earats.sizats.yloc, Rats(i).Siz * .3, Rats(i).Colr
  wX = .5 * Rats(i).Siz * COS(Rats(i).Rot - _PI(11 / 18))
  wY = .5 * Rats(i).Siz * SIN(Rats(i).Rot - _PI(11 / 18))
  LINE (noseX + wX, noseY + wY)-(noseX - wX, noseY - wY), Rats(i).Colr
  wX = .5 * Rats(i).Siz * COS(Rats(i).Rot - _PI(7 / 18))
  wY = .5 * Rats(i).Siz * SIN(Rats(i).Rot - _PI(7 / 18))
  LINE (noseX + wX, noseY + wY)-(noseX - wX, noseY - wY), Rats(i).Colr
  LINE (Rats(i).Xloc, Rats(i).Yloc)-(tailX, tailY), Rats(i).Colr
 ELSE 'out of bounds
  newRat i
 END IF
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

'vince version
SUB fcirc (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
 x0 = R
 y0 = 0
 e = 0
 DO WHILE y0 < x0
  IF e <= 0 THEN
   y0 = y0 + 1
   LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
   LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
   e = e + 2 * y0
  ELSE
   LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
   LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
   x0 = x0 - 1
   e = e - 2 * x0
  END IF
 LOOP
 LINE (x - R, y)-(x + R, y), C, BF
END SUB

FUNCTION ratKolor~& ()
 r% = INT(RND * 70) + 70
 g% = INT(RND * (.5 * r%)) + .2 * r%
 b% = INT(RND * (.4 * g%)) + .1 * g%
 ' r% = 165: g% = 95: b% = 25
 ratKolor~& = _RGB32(r%, g%, b%)
END FUNCTION

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

SUB drawshooter (x, y, radianAngle) 'simple red iso triangle pointed towards radianAngle
 'calculate 3 points of triangle shooter
 x1 = x + 60 * COS(radianAngle) 'main point of shooter according to heading
 y1 = y + 60 * SIN(radianAngle)
 x2 = x + 30 * COS(radianAngle + _PI(2 / 3)) 'next two points are 120 degrees off main point in direction
 y2 = y + 30 * SIN(radianAngle + _PI(2 / 3))
 x3 = x + 30 * COS(radianAngle - _PI(2 / 3))
 y3 = y + 30 * SIN(radianAngle - _PI(2 / 3))
 fTri x, y, x1, y1, x2, y2, _RGB(255, 0, 0)
 fTri x, y, x1, y1, x3, y3, _RGB(255, 0, 0)
 LINE (x1, y1)-(x2, y2), _RGB32(255, 255, 128)
 LINE (x1, y1)-(x3, y3), _RGB32(255, 255, 128)
 LINE (x1, y1)-(x, y), _RGB32(255, 255, 128)
END SUB

FUNCTION shotprocess (Count%%)
 IF Count%% THEN 'are there active shots to move
  FOR i%% = 0 TO Count%% - 1
   Shot(i%%).Xloc = Shot(i%%).Xloc + Shot(i%%).DXval
   Shot(i%%).Yloc = Shot(i%%).Yloc + Shot(i%%).DYval

   'check for shot hitting rat
   IF RatCollision(i%%) THEN behappy = yes

   IF Shot(i%%).Xloc > 0 AND Shot(i%%).Xloc < ScrnX AND Shot(i%%).Yloc > 0 AND Shot(i%%).Yloc < ScrnY THEN 'in bounds draw it
    fcirc Shot(i%%).Xloc, Shot(i%%).Yloc, 2, _RGB32(170, 130, 10)
   ELSE 'shot is off screen
    Shot(i%%).RemFlag = TRUE
   END IF
  NEXT i%%
  'check for offscreen shots
  FOR j%% = 0 TO Count%%
   IF Shot(j%%).RemFlag THEN 'shot is flaged for removal from rathit or offscreen
    FOR i%% = j%% TO Count%% + 1
     Shot(i%%).Xloc = Shot(i%% + 1).Xloc
     Shot(i%%).Yloc = Shot(i%% + 1).Yloc
     Shot(i%%).DXval = Shot(i%% + 1).DXval
     Shot(i%%).DYval = Shot(i%% + 1).DYval
     Shot(i%%).RemFlag = Shot(i%% + 1).RemFlag
    NEXT i%%
    Count%% = Count%% - 1
   END IF
  NEXT j%%
 END IF
 shotprocess = Count%%
END FUNCTION

FUNCTION NewShot (id%%)
 'fire a bullet
 Shot(id%%).Xloc = P.Xloc + 3 * BulletSpeed * COS(P.Rot)
 Shot(id%%).Yloc = P.Yloc + 3 * BulletSpeed * SIN(P.Rot)
 Shot(id%%).DXval = BulletSpeed * COS(P.Rot)
 Shot(id%%).DYval = BulletSpeed * SIN(P.Rot)
 Shot(id%%).RemFlag = FALSE
 id%% = id%% + 1
 NewShot = id%%
END FUNCTION

SUB PlayerMovement
 'move player around if they have momentum
 P.Xloc = P.Xloc + P.Momentum * COS(P.ThrstRot)
 P.Yloc = P.Yloc + P.Momentum * SIN(P.ThrstRot)
 'stop the player if they encroach upon the screen bounds
 IF P.Xloc < 30 OR P.Yloc < 30 OR P.Xloc > ScrnX - 30 OR P.Yloc > ScrnY - 30 THEN P.Momentum = 0
 'now that does allow player to move extreamly slow, like they are stuck in tar! but they
 'can still leave screen, in that case they lose a life.

 IF P.Xloc <= 0 OR P.Xloc >= ScrnX OR P.Yloc <= 0 OR P.Yloc >= ScrnY THEN
  P.Life = P.Life + 1 'player left screen by force! KILL EM'
  P.Xloc = ScrnX \ 2: P.Yloc = ScrnY \ 2
 END IF
END SUB

FUNCTION RatCollision (id%%)
 FOR j%% = 0 TO RatCount * P.Life
  check~& = POINT(Shot(id%%).Xloc, Shot(id%%).Yloc)
  IF check~& <> 0 THEN 'if bullet finds a nother color
   FOR i%% = 0 TO RatCount * P.Life 'which rat was hit.
    IF Rats(i%%).Colr = check~& THEN 'found dead rat
     'give player points
     P.Points = P.Points + (RatScore - Rats(i%%).Siz)
     'kill that rat
     newRat i%%
     'kill the shot
     Shot(id%%).RemFlag = TRUE
     'exit the for next loop
     i%% = RatCount * P.Life + 2
    END IF
   NEXT i%%
   results%% = TRUE
  ELSE
   results%% = FALSE
  END IF
 NEXT j%%
 RatCollision = results%%
END FUNCTION
2
Off-Topic / The Programmer's Edition forum status - July 7th, 2018
« Last post by Waltersmind on Yesterday at 01:32:00 PM »
Community Notice:

The upgraded and rebranded programming forum (formerly known as: The QB64 Edition) appears to be functioning correctly, however, there are some changes I need to make before I can reopen it.

I am known for periodically changing the theme of my forum, but to save some time so I can reopen a lot faster, I will keep the current "plain" theme. However, I have to make modifications to the physical structures to the site before any theme is applied to it. For example:
  •     The posts need to be separated from one another in a thread, as the current forum software runs them together, which makes it difficult to see where one ends and where one begins.
  •     Elements in the "Post a New Thread" and "Post a New Reply" pages need to be removed and some need to be moved around to give a more user-friendly user experience.
  •     I have to reorganize the categories on the forum's index page to flow with the forum's new branding.
With the generic version of the latest MyBB forum software, there are some major differences between it and the version I used for The QB64 Edition.
  •     The categories/forums/threads/posts read and not read system actually works.
  •     The edit box in "Post a New Thread" and "Post a New Reply" pages automatically fill the entire width of the area it is in.
  •     The breadcrumb line at the top now offers a drop-down box to show a list of the multiple pages a thread may have.
  •     ...and many more...
This, however, does not include any additional plugins I am looking into using on the site. So at this point, there is no telling what goodies will be waiting for members and users when I reopen the forum.

One last note, I am feeling fairly confident that I should be reopening the forum sometime this weekend. When I do, all access to the old "The QB64 Edition" will cease to exist, and all links will be redirected to the new forum ("The Programmer's Edition"). The old site will no longer work when I upgrade my servers copy of PHP from 5.6 to 7.1, so there is no reason why I need to keep the old site around.
3
QB64 Discussion / Re: Images with Semi-transparency? (StarBlast Game)
« Last post by Waltersmind on Yesterday at 11:04:07 AM »
@SirCrow,

Quote
If there's a way to do it w/ _PUTIMAGE and have it rotate along with the ship, it's likely beyond my skill level.

If you look at the code to my clock demo I mentioned before, you will find everything you need in it. It has a FUNCTION in it that will help you rotate and scale your image. There are other versions of it as well in some of my other demos, but I won't list them here so I don't overwhelm you too much.

The clock demo also shows other techniques like procedurally creating graphics in their own _NEWIMAGE, setting the alpha values for a specific or range of colors, how to do shadows, how to use a "Game Loop", and other valuable techniques.

Since all images in the demo are procedurally generated (created in real time), I decided to share it here as well for everyone's convenience.

Here is the code which will run straight out of the box:

Code: [Select]
' *****************************************************************************
' *                                                                           *
' *  DIGITAL CLOCK #3                                                         *
' *                                                                           *
' *  By: Waltersmind                                                          *
' *  Created on: Feburary 1st, 2014                                           *
' *  Modified on: Feburary 10th, 2014                                         *
' *                                                                           *
' *  All values are hard-coded in the source.                                 *
' *                                                                           *
' *****************************************************************************

DIM SHARED PrimaryScreen&
DIM SHARED PrimaryScreenSaved&
DIM SHARED PrimaryScreenBackBuffer&
DIM SHARED PrimaryScreenBackBuffer2&
DIM SHARED ClockFace&
DIM SHARED ClockCover&
DIM SHARED HourHand&
DIM SHARED MinuteHand&
DIM SHARED SecondHand&
DIM SHARED ClockScratch1&
DIM SHARED ClockShadow&
DIM SHARED Pendulum&
DIM SHARED color1~&, color2~&, color3~&, color4~&, color5~&
DIM SHARED degree AS DOUBLE
DIM SHARED Hours(0 TO 11) AS STRING
DIM SHARED Object1MaxWidth&
DIM SHARED Object1MaxHeight&
DIM SHARED CenterX%
DIM SHARED CenterY%
DIM SHARED NumSteps%
DIM SHARED currentStep%
DIM SHARED clockAlpha%

Object1MaxWidth& = 80
Object1MaxHeight& = 80
CenterX% = Object1MaxWidth& / 2
CenterY% = Object1MaxHeight& / 2
NumSteps% = 50 '100
currentStep% = 0
clockAlpha% = 120

Hours(0) = "XII": Hours(1) = "I": Hours(2) = "II": Hours(3) = "III": Hours(4) = "IV": Hours(5) = "V"
Hours(6) = "VI": Hours(7) = "VII": Hours(8) = "VIII": Hours(9) = "IX": Hours(10) = "X": Hours(11) = "XI"

PrimaryScreen& = _NEWIMAGE(800, 600, 32)
PrimaryScreenSaved& = _NEWIMAGE(800, 600, 32)
PrimaryScreenBackBuffer& = _NEWIMAGE(800, 600, 32)
PrimaryScreenBackBuffer2& = _NEWIMAGE(800, 600, 32)
ClockFace& = _NEWIMAGE(400, 400, 32)
ClockCover& = _NEWIMAGE(400, 400, 32)
HourHand& = _NEWIMAGE(20, 160, 32)
MinuteHand& = _NEWIMAGE(20, 185, 32)
SecondHand& = _NEWIMAGE(10, 185, 32)
ClockScratch1& = _NEWIMAGE(400, 400, 32)
ClockShadow& = _NEWIMAGE(300, 40, 32)
Pendulum& = _NEWIMAGE(100, 200, 32)
CircleBuffer1~& = _NEWIMAGE(Object1MaxWidth&, Object1MaxHeight&, 32)

degree = 3.141592654 / 180

_DEST PrimaryScreenSaved&
GradientBox 0, 0, 799, 599, _RGB(49, 130, 186), _RGB(209, 227, 239), "h"
StartColor~& = _RGB(RND * 256, RND * 256, RND * 256)
EndColor~& = _RGB(RND * 256, RND * 256, RND * 256)
redInc! = -(_RED32(StartColor~&) - _RED32(EndColor~&)) / NumSteps%
greenInc! = -(_GREEN32(StartColor~&) - _GREEN32(EndColor~&)) / NumSteps%
blueInc! = -(_BLUE32(StartColor~&) - _BLUE32(EndColor~&)) / NumSteps%

SCREEN PrimaryScreen&
GradientBox 0, 0, 799, 599, _RGB(49, 130, 186), _RGB(209, 227, 239), "h"

color1~& = _RGBA(254, 234, 197, 255)
color2~& = _RGBA(183, 147, 91, 255)
color3~& = _RGBA(127, 72, 31, 255)
color4~& = _RGBA(94, 49, 21, 255)
color5~& = _RGBA(61, 32, 13, 255)

DrawClock

DO
    _LIMIT 30

    _DEST CircleBuffer1~&
    Red% = _RED32(StartColor~&) + redInc! * currentStep%
    Green% = _GREEN32(StartColor~&) + greenInc! * currentStep%
    Blue% = _BLUE32(StartColor~&) + blueInc! * currentStep%

    FOR numCircles = 1 TO 20
        CLS
        radius = RND * (Object1MaxWidth& / 2 - 2)
        ImageX% = (radius - (Object1MaxWidth& / 2)) + RND * (_WIDTH(PrimaryScreenSaved&) - radius * 2)
        ImageY% = (radius - (Object1MaxHeight& / 2)) + RND * (_HEIGHT(PrimaryScreenSaved&) - radius * 2)

        CIRCLE (CenterX%, CenterY%), radius, _RGB(Red%, Green%, Blue%)
        PAINT (CenterX%, CenterY%), _RGB(Red%, Green%, Blue%)

        _SETALPHA 0, _RGB(0, 0, 0)
        _SETALPHA INT(RND * 128) + 127, _RGB(Red%, Green%, Blue%), CircleBuffer1~&
        _PUTIMAGE (ImageX%, ImageY%), CircleBuffer1~&, PrimaryScreenSaved&, (0, 0)-(Object1MaxWidth& - 1, Object1MaxHeight& - 1)
    NEXT

    currentStep% = currentStep% + 1

    IF currentStep% > NumSteps% THEN
        currentStep% = 0
        SWAP StartColor~&, EndColor~&
        EndColor~& = _RGB(RND * 256, RND * 256, RND * 256)
        redInc! = -(_RED32(StartColor~&) - _RED32(EndColor~&)) / NumSteps%
        greenInc! = -(_GREEN32(StartColor~&) - _GREEN32(EndColor~&)) / NumSteps%
        blueInc! = -(_BLUE32(StartColor~&) - _BLUE32(EndColor~&)) / NumSteps%
    END IF

    _PUTIMAGE (0, 0)-(_WIDTH(PrimaryScreenBackBuffer2&), _HEIGHT(PrimaryScreenBackBuffer2&)), PrimaryScreenSaved&, PrimaryScreenBackBuffer2&

    FOR ShadowWidth = 1 TO 0.70 STEP -0.05
        drawImage ClockShadow&, PrimaryScreenBackBuffer2&, 400, 590, _WIDTH(ClockShadow&) / 2, _HEIGHT(ClockShadow&) - 20, 0, ShadowWidth
    NEXT

    _PUTIMAGE (0, 0)-(399, 399), ClockFace&, ClockScratch1&

    TinyTimer# = TIMER
    Hour% = (INT(TinyTimer# / 3600) MOD 60) MOD 12: Hour% = Hour% + 12 * -(Hour% = 0)
    Minute% = INT(TinyTimer# / 60) MOD 60
    Second% = INT(TinyTimer#) MOD 60
    SixthSecond# = 0 '(TinyTimer# - INT(TinyTimer#)) * 6

    _DEST ClockScratch1&
    DisplayTimeLine2$ = LTRIM$(LTRIM$(STR$(Hour%))) + ":" + RIGHT$("0" + LTRIM$(STR$(Minute%)), 2) + ":" + RIGHT$("0" + LTRIM$(STR$(Second%)), 2) + " " + MID$("AMPM", -((INT(TinyTimer# / 3600) MOD 60) > 11) * 2 + 1, 2)
    _PRINTMODE _KEEPBACKGROUND
    _PRINTSTRING (199 - (_PRINTWIDTH(DisplayTimeLine2$) / 2), 299), DisplayTimeLine2$

    drawImage HourHand&, ClockScratch1&, 199, 199, _WIDTH(HourHand&) / 2, _HEIGHT(HourHand&) - 20, (Hour% * 30 + Minute% / 2) * degree, 1
    drawImage MinuteHand&, ClockScratch1&, 199, 199, _WIDTH(MinuteHand&) / 2, _HEIGHT(MinuteHand&) - 20, (Minute% * 6 + Second% / 10) * degree, 1
    drawImage SecondHand&, ClockScratch1&, 199, 199, _WIDTH(SecondHand&) / 2, _HEIGHT(SecondHand&) - 20, (Second% * 6 + SixthSecond#) * degree, 1
    drawImage ClockCover&, ClockScratch1&, 4, 91, _WIDTH(SecondHand&) / 2, _HEIGHT(SecondHand&) / 2, 0, 1

    radius# = 15
    speed# = 3
    angle! = (radius# * SIN(TinyTimer# * speed#)) * degree
    drawImage Pendulum&, PrimaryScreenBackBuffer2&, 399, 214, _WIDTH(Pendulum&) / 2, -179, angle!, 1

    _SETALPHA 150, _RGB(1, 1, 1) TO _RGB(255, 255, 255), ClockScratch1&
    _PUTIMAGE (199, 25)-(599, 425), ClockScratch1&, PrimaryScreenBackBuffer2&

    _SETALPHA 0, _RGB(0, 0, 0), PrimaryScreenBackBuffer2&
    _SETALPHA clockAlpha%, _RGB(1, 1, 1) TO _RGB(255, 255, 255), PrimaryScreenBackBuffer2&
    _PUTIMAGE (0, 0)-(_WIDTH(PrimaryScreenBackBuffer&), _HEIGHT(PrimaryScreenBackBuffer&)), PrimaryScreenBackBuffer2&, PrimaryScreenBackBuffer&
    _PUTIMAGE (0, 0)-(_WIDTH(PrimaryScreenBackBuffer&), _HEIGHT(PrimaryScreenBackBuffer&)), PrimaryScreenBackBuffer&, PrimaryScreen&

    _DISPLAY

LOOP WHILE INKEY$ = ""
SYSTEM


'##############################################################################
'#                                                                            #
'#  DrawClock (): No parameters                                               #
'#                                                                            #
'##############################################################################
SUB DrawClock ()


' -----------------------------------------------------------------------------
'  Draw outer clock rim
' -----------------------------------------------------------------------------

_DEST ClockFace&

GradientBox 0, 0, 399, 399, color3~&, color4~&, "h"
CIRCLE (199, 199), 200, _RGBA(0, 0, 0, 255)
PAINT (0, 0), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
PAINT (0, 399), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
PAINT (399, 0), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
PAINT (399, 399), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
_SETALPHA 0, _RGB(0, 0, 0)


' -----------------------------------------------------------------------------
'  Draw inner bevel gradient
' -----------------------------------------------------------------------------

_DEST ClockScratch1&

GradientBox 0, 0, 399, 399, color4~&, color3~&, "h"
CIRCLE (199, 199), 190, _RGBA(0, 0, 0, 255)
PAINT (0, 0), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
PAINT (0, 399), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
PAINT (399, 0), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
PAINT (399, 399), _RGBA(0, 0, 0, 255), _RGBA(0, 0, 0, 255)
_SETALPHA 0, _RGB(0, 0, 0)
_PUTIMAGE (0, 0)-(399, 399), ClockScratch1&, ClockFace&


' -----------------------------------------------------------------------------
'  Draw inner clock face
' -----------------------------------------------------------------------------

GradientCircle 199, 199, 186, color1~&, color2~&
CIRCLE (199, 199), 187, color5~&
_SETALPHA 0, _RGB(0, 0, 0)
_PUTIMAGE (0, 0)-(399, 399), ClockScratch1&, ClockFace&


' -----------------------------------------------------------------------------
'  Draw second ticks
' -----------------------------------------------------------------------------

CLS 0
LINE (199, 15)-(201, 25), color5~&, BF

FOR angle# = 0 TO 360 STEP 6
    _SETALPHA 0, _RGB(0, 0, 0)
    drawImage ClockScratch1&, ClockFace&, 199, 199, 199, 199, angle# * degree, 1
NEXT


' -----------------------------------------------------------------------------
'  Draw minute ticks
' -----------------------------------------------------------------------------

CLS 0
LINE (198, 15)-(202, 35), color5~&, BF

FOR angle# = 0 TO 360 STEP 30
    _SETALPHA 0, _RGB(0, 0, 0)
    drawImage ClockScratch1&, ClockFace&, 199, 199, 199, 199, angle# * degree, 1
NEXT


' -----------------------------------------------------------------------------
'  Draw Roman Numerals
' -----------------------------------------------------------------------------

HourArrayCount = -1

COLOR color5~&

FOR angle# = 0 TO 330 STEP 30
    CLS 0
    HourArrayCount = HourArrayCount + 1
    _PRINTSTRING (199 - (_PRINTWIDTH(Hours(HourArrayCount)) / 2), 45), Hours(HourArrayCount)
    _SETALPHA 0, _RGB(0, 0, 0)
    drawImage ClockScratch1&, ClockFace&, 199, 199, 199, 199, angle# * degree, 1
NEXT


' -----------------------------------------------------------------------------
'  Draw minute Hand
' -----------------------------------------------------------------------------

_DEST MinuteHand&

MinuteHandWidth# = _WIDTH(MinuteHand&)
MinuteHandHeight# = _HEIGHT(MinuteHand&)
HandColor1~& = color3~&
HandColor2~& = color5~&

' LEFT SIDE
LINE (MinuteHandWidth# / 2, 0)-(0, MinuteHandHeight# - 20), HandColor1~&
LINE -(MinuteHandWidth# / 2, MinuteHandHeight#), HandColor1~&
LINE -(MinuteHandWidth# / 2, 0), HandColor1~&
PAINT (MinuteHandWidth# / 2 - 2, MinuteHandHeight# - 20), HandColor1~&

' RIGHT SIDE
LINE (MinuteHandWidth# / 2, 0)-(MinuteHandWidth#, MinuteHandHeight# - 20), HandColor2~&
LINE -(MinuteHandWidth# / 2, MinuteHandHeight#), HandColor2~&
LINE -(MinuteHandWidth# / 2, 0), HandColor2~&
PAINT (MinuteHandWidth# / 2 + 2, MinuteHandHeight# - 20), HandColor2~&

_SETALPHA 150, _RGB(1, 1, 1) TO _RGB(255, 255, 255)
_SETALPHA 0, _RGB(0, 0, 0)


' -----------------------------------------------------------------------------
'  Draw hour Hand
' -----------------------------------------------------------------------------

_DEST HourHand&

HourHandWidth# = _WIDTH(HourHand&)
HourHandHeight# = _HEIGHT(HourHand&)
HandColor1~& = color3~&
HandColor2~& = color5~&

' LEFT SIDE
LINE (HourHandWidth# / 2, 0)-(0, HourHandHeight# - 20), HandColor1~&
LINE -(HourHandWidth# / 2, HourHandHeight#), HandColor1~&
LINE -(HourHandWidth# / 2, 0), HandColor1~&
PAINT (HourHandWidth# / 2 - 2, HourHandHeight# - 20), HandColor1~&

' RIGHT SIDE
LINE (HourHandWidth# / 2, 0)-(HourHandWidth#, HourHandHeight# - 20), HandColor2~&
LINE -(HourHandWidth# / 2, HourHandHeight#), HandColor2~&
LINE -(HourHandWidth# / 2, 0), HandColor2~&
PAINT (HourHandWidth# / 2 + 2, HourHandHeight# - 20), HandColor2~&

_SETALPHA 150, _RGB(1, 1, 1) TO _RGB(255, 255, 255)
_SETALPHA 0, _RGB(0, 0, 0)


' -----------------------------------------------------------------------------
'  Draw second Hand
' -----------------------------------------------------------------------------

_DEST SecondHand&

SecondHandWidth# = _WIDTH(SecondHand&)
SecondHandHeight# = _HEIGHT(SecondHand&)
HandColor1~& = _RGB(255, 0, 0)

LINE (SecondHandWidth# / 2, 0)-(0, SecondHandHeight# - 20), HandColor1~&
LINE -(SecondHandWidth# / 2, SecondHandHeight#), HandColor1~&
LINE -(SecondHandWidth#, SecondHandHeight# - 20), HandColor1~&
LINE -(SecondHandWidth# / 2, 0), HandColor1~&
PAINT (SecondHandWidth# / 2, SecondHandHeight# - 20), HandColor1~&

_SETALPHA 150, _RGB(1, 1, 1) TO _RGB(255, 255, 255)
_SETALPHA 0, _RGB(0, 0, 0)


' -----------------------------------------------------------------------------
'  Draw glass cover
' -----------------------------------------------------------------------------

_DEST ClockCover&

CIRCLE (199, 199), 185, _RGBA(255, 255, 255, 255)
PAINT (199, 199), _RGBA(255, 255, 255, 255), _RGBA(255, 255, 255, 255)
CIRCLE (299, 299), 174, _RGBA(0, 0, 0, 255)
PAINT (280, 280), _RGBA(0, 0, 0, 255)

_SETALPHA 0, _RGB(0, 0, 0)
_SETALPHA 50, _RGB(255, 255, 255)


' -----------------------------------------------------------------------------
'  Draw drop shadow
' -----------------------------------------------------------------------------

_DEST ClockShadow&

LINE (0, 0)-(_WIDTH(ClockShadow&), _HEIGHT(ClockShadow&)), _RGB(255, 255, 255), BF
CIRCLE (_WIDTH(ClockShadow&) / 2, _HEIGHT(ClockShadow&) / 2), _WIDTH(ClockShadow&) / 2, _RGB(0, 0, 0), , , 0.10
PAINT (_WIDTH(ClockShadow&) / 2, _HEIGHT(ClockShadow&) / 2), _RGB(0, 0, 0)

_SETALPHA 50, _RGB(0, 0, 0)
_SETALPHA 0, _RGB(255, 255, 255)


' -----------------------------------------------------------------------------
'  Draw Pendulum
' -----------------------------------------------------------------------------

_DEST Pendulum&

PBoxX1 = _WIDTH(Pendulum&) / 4
PBoxY1 = 0
PBoxX2 = (_WIDTH(Pendulum&) / 4) * 3
PBoxY2 = _HEIGHT(Pendulum&) - (_WIDTH(Pendulum&) / 2)
PBallCX = _WIDTH(Pendulum&) / 2
PBallCY = PBoxY2
PBallRadius = PBallCX - 2
PendulumColor1~& = color5~&
PendulumColor2~& = color2~&

GradientBox PBoxX1, PBoxY1, PBallCX, PBoxY2, PendulumColor1~&, PendulumColor2~&, "v"
GradientBox PBallCX, PBoxY1, PBoxX2, PBoxY2, PendulumColor2~&, PendulumColor1~&, "v"
GradientCircle PBallCX, PBallCY, PBallRadius, PendulumColor2~&, PendulumColor1~&

_SETALPHA 0, _RGB(0, 0, 0)


END SUB


'##############################################################################
'#                                                                            #
'# drawImage (Source Image, Destination Image, XCooridnate for center of      #
'#            image in the destination, YCoordinate for center of image in    #
'#            the destination, pivot XCoordinate for source image, pivot      #
'#            YCoordinate for source image, Angle of rotation, scale (1 =     #
'#            100%)                                                           #
'#                                                                            #
'##############################################################################
SUB drawImage (src AS LONG, dest AS LONG, x AS INTEGER, y AS INTEGER, centerX AS INTEGER, centerY AS INTEGER, angle AS DOUBLE, scale AS DOUBLE)

' -----------------------------------------------------------------------------
'  The following sets the pivot location (the axis where the image rotates).
'  This location can be inside the image, such as center, or it can be outside.
' -----------------------------------------------------------------------------

TopLeftX = -centerX
TopLeftY = -centerY
BottomLeftX = -centerX
BottomLeftY = -centerY + _HEIGHT(src)
BottomRightX = -centerX + _WIDTH(src)
BottomRightY = -centerY + _HEIGHT(src)
TopRightX = -centerX + _WIDTH(src)
TopRightY = -centerY

' -----------------------------------------------------------------------------
'  Predefine the SIN and COS rotation for later use
' -----------------------------------------------------------------------------

RotSin! = SIN(-angle)
RotCos! = COS(-angle)

' -----------------------------------------------------------------------------
'  Translate, rotate, and scale all four corner vectors
' -----------------------------------------------------------------------------

TopLeftCornerX = (TopLeftX * RotCos! + TopLeftY * RotSin!) * scale + x
TopLeftCornerY = (TopLeftY * RotCos! - TopLeftX * RotSin!) * scale + y
BottomLeftCornerX = (BottomLeftX * RotCos! + BottomLeftY * RotSin!) * scale + x
BottomLeftCornerY = (BottomLeftY * RotCos! - BottomLeftX * RotSin!) * scale + y
BottomRightCornerX = (BottomRightX * RotCos! + BottomRightY * RotSin!) * scale + x
BottomRightCornerY = (BottomRightY * RotCos! - BottomRightX * RotSin!) * scale + y
TopRightCornerX = (TopRightX * RotCos! + TopRightY * RotSin!) * scale + x
TopRightCornerY = (TopRightY * RotCos! - TopRightX * RotSin!) * scale + y

' -----------------------------------------------------------------------------
'  Put the source image onto the destination image in the source image
'  transformed state.
'
'  TL - BL - BR, TL - BL - BR
'  TL - BR - TR, TL - BR - TR
' -----------------------------------------------------------------------------

TLX = 0
TLY = 0
BLX = 0
BLY = _HEIGHT(src) - 1
BRX = _WIDTH(src) - 1
BRY = _HEIGHT(src) - 1
TRX = _WIDTH(src) - 1
TRY = 0

_MAPTRIANGLE _SEAMLESS(TLX, TLY)-(BLX, BLY)-(BRX, BRY), src TO(TopLeftCornerX, TopLeftCornerY)-(BottomLeftCornerX, BottomLeftCornerY)-(BottomRightCornerX, BottomRightCornerY), dest
_MAPTRIANGLE _SEAMLESS(TLX, TLY)-(BRX, BRY)-(TRX, TRY), src TO(TopLeftCornerX, TopLeftCornerY)-(BottomRightCornerX, BottomRightCornerY)-(TopRightCornerX, TopRightCornerY), dest

END SUB


'##############################################################################
'#                                                                            #
'# GradientCircle(X-Coordinate, Y-Coordinate, Radius, InnerCircleColor,       #
'#                OuterCircleColor)                                           #
'#                                                                            #
'##############################################################################
SUB GradientCircle (x1 AS INTEGER, y1 AS INTEGER, radius AS INTEGER, innerColor AS LONG, outerColor AS LONG)

redInc! = -(_RED32(outerColor) - _RED32(innerColor)) / radius
greenInc! = -(_GREEN32(outerColor) - _GREEN32(innerColor)) / radius
blueInc! = -(_BLUE32(outerColor) - _BLUE32(innerColor)) / radius
alphaInc! = -(_ALPHA32(outerColor) - _ALPHA32(innerColor)) / radius

colorInc = 0
FOR r = radius TO 0 STEP -2
    CIRCLE (x1, y1), r, _RGBA(_RED32(outerColor) + (redInc! * colorInc), _GREEN32(outerColor) + (greenInc! * colorInc), _BLUE32(outerColor) + (blueInc! * colorInc), _ALPHA(outerColor) + (alphaInc! * colorInc))
    PAINT (x1, y1), _RGBA(_RED32(outerColor) + (redInc! * colorInc), _GREEN32(outerColor) + (greenInc! * colorInc), _BLUE32(outerColor) + (blueInc! * colorInc), _ALPHA(outerColor) + (alphaInc! * colorInc))
    colorInc = colorInc + 2
NEXT

END SUB


'##############################################################################
'#                                                                            #
'# GradientBox(X Start Coordinate, Y Start Coordinate, X End Coordinate,      #
'#             Y End Coordinate, Color Start, Color End, Is it "h"            #
'#             for Horizontal or "v" for Vertical?)                           #
'#                                                                            #
'##############################################################################
SUB GradientBox (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, colorStart AS _UNSIGNED LONG, colorEnd AS _UNSIGNED LONG, HortVert AS STRING)

IF x2 < x1 THEN SWAP x1, x2: IF HortVert = "h" THEN SWAP colorStart, colorEnd
IF y2 < y1 THEN SWAP y1, y2: IF HortVert = "v" THEN SWAP colorStart, colorEnd

colorSteps% = ABS(((x2 - x1) * (HortVert = "h")) + ((y2 - y1) * (HortVert = "v")))

redInc! = ABS(_RED32(colorStart) - _RED32(colorEnd)) / colorSteps%
greenInc! = ABS(_GREEN32(colorStart) - _GREEN32(colorEnd)) / colorSteps%
blueInc! = ABS(_BLUE32(colorStart) - _BLUE32(colorEnd)) / colorSteps%
alphaInc! = ABS(_ALPHA32(colorStart) - _ALPHA32(colorEnd)) / colorSteps%

IF HortVert = "h" THEN
    colorInc = 0
    FOR y = y1 TO y2
        LINE (x1, y)-(x2, y), _RGBA(_RED32(colorStart) + (redInc! * colorInc), _GREEN32(colorStart) + (greenInc! * colorInc), _BLUE32(colorStart) + (blueInc! * colorInc), _ALPHA(colorStart) + (alphaInc! * colorInc))
        colorInc = colorInc + 1
    NEXT
END IF

IF HortVert = "v" THEN
    colorInc = 0
    FOR x = x1 TO x2
        LINE (x, y1)-(x, y2), _RGBA(_RED32(colorStart) + (redInc! * colorInc), _GREEN32(colorStart) + (greenInc! * colorInc), _BLUE32(colorStart) + (blueInc! * colorInc), _ALPHA(colorStart) + (alphaInc! * colorInc))
        colorInc = colorInc + 1
    NEXT
END IF

END SUB
Have a Joyful coding experience!
4
Off-Topic / Re: The QB64 Edition forum has been closed.
« Last post by Waltersmind on Yesterday at 10:50:30 AM »
Community Announcement:

I have reopened The QB64 Edition in read-only mode so users can still continue to browse the forum while I am preparing the new one.

It's not fair to everyone that I keep the forum all closed up so no one can browse it while I am working to get the new up and running.
5
Programs / Re: QB64 Scra88le Board Game - Historical Copy
« Last post by Qwerkey on Yesterday at 08:27:36 AM »
Quote from: SMcNeill on July 18, 2018, 02:59:04 PM

There's no single Scrabble Official Word List, as explained here: https://www.wordplays.com/official-scrabble-word-lists/

Makes me wonder, since it's Brittish, can it use "color", "colour", or both versions of the spelling? 


Thanks Steve, you have found the origin of the dictionary used with the program: the one I obtained from that official site is called "SOWOPDS Europe".  Both "color" and "colour" are acceptable.

Richard
6
Off-Topic / Re: The QB64 Edition down?
« Last post by Qwerkey on Yesterday at 06:25:14 AM »
Quote from: luke on July 22, 2017, 01:10:28 AM
I smite
He smites
I smote
I have smitten or I have smote
I am smiting


I have that the past tense of "smite" is "smote", past particle is "smitten" but not "smote".  Must be differences in local English.  Thank goodness that we are not French, or the Académie française would be on to us.  I realise (UK English spelling!) that this belated reply is highly important to the QB64 forum.

Richard
7
QB64 Discussion / Re: Images with Semi-transparency? (StarBlast Game)
« Last post by SirCrow on July 18, 2018, 09:21:45 PM »
Quote from: johnno56 on July 18, 2018, 09:12:11 PM
I do not know how this is done... But if the ship is drawn than can you not draw the shadow or would it appear too dark? I hope I'm making sense...

Currently, the ship's shadow is done using DRAW.  Although I've used POINT() to detect the terrain's lightness and adjust the shadow accordingly -- to rather nice effect, I think -- I'd rather it just be translucent like the asteroids' shadows now are.  If there's a way to do it w/ _PUTIMAGE and have it rotate along with the ship, it's likely beyond my skill level.
8
QB64 Discussion / Re: Images with Semi-transparency? (StarBlast Game)
« Last post by johnno56 on July 18, 2018, 09:12:11 PM »
I do not know how this is done... But if the ship is drawn than can you not draw the shadow or would it appear too dark? I hope I'm making sense...

J
9
QB64 Discussion / Re: Images with Semi-transparency? (StarBlast Game)
« Last post by SirCrow on July 18, 2018, 07:48:38 PM »
Quote from: Waltersmind on July 18, 2018, 06:18:10 PM
Quote
Is there a relatively simple way to make images have semi-transparency using _LOADIMAGE and/or _PUTIMAGE?

Due to this question, I decided to reopen "The QB64 Edition" in read-only mode so users can still have access to the great content over there.

@SirCrow, you can use _SETALPHA to make images draw in a semi-transparent fashion.

Here is an old demo of mine that uses this command to make a hauntingly-dreamy clock. You can view the code, see a screenshot, and watch the demo in action in YouTube video, all of which are in the post so you don't have to click on things or go offsite. You can see the post at: http://qb64.thejoyfulprogrammer.com/showthread.php?tid=16

Thanks, Walter, and everyone else!  Glad to see there is something that even I can probably handle!
(I only wish I hadn't just wasted time manually blacking out every other column in one of my asteroid shadow images to achieve the translucency.  Didn't like the look of it in the game at all.)

Thanks again.  I'll look into the commands, metas and keywords and get back to you soon!

EDIT:  Just tried it and.....BEAUTIFUL!  Just what the doctor ordered.  My asteroids floating above an alien landscape now have lovely shadows that reveal the ground underneath!  How nice!  Now, what do I do about the ship's shadow?  I made it using DRAW, and I don't see anyway of making that semi-transparent.  Hmm...   In any case, I'm pretty happy with how it is now.  :o)
10
QB64 Discussion / Re: Images with Semi-transparency? (StarBlast Game)
« Last post by Waltersmind on July 18, 2018, 06:18:10 PM »
Quote
Is there a relatively simple way to make images have semi-transparency using _LOADIMAGE and/or _PUTIMAGE?

Due to this question, I decided to reopen "The QB64 Edition" in read-only mode so users can still have access to the great content over there.

@SirCrow, you can use _SETALPHA to make images draw in a semi-transparent fashion.

Here is an old demo of mine that uses this command to make a hauntingly-dreamy clock. You can view the code, see a screenshot, and watch the demo in action in YouTube video, all of which are in the post so you don't have to click on things or go offsite. You can see the post at: http://qb64.thejoyfulprogrammer.com/showthread.php?tid=16
Pages: [1] 2 3 ... 10