Here's the source code for my BLUEGOLD entry for the low res challenge. As I was going through adding comments I wondered how many people needed extreme comments, so I stopped.
If you have any questions about the source, please ask.
' ------------------------------------------------------------------------------
' Blue and Gold
'
' ------------------------------------------------------------------------------
' ------------------------------------------------------------------------------
' Include any libraries and external code files that we want to use
' ------------------------------------------------------------------------------
#Include Once "tinyptc.bi"
#include once "windows.bi"
#include "ufmod.bi"
#include "music.bas"
Dim hWave As HWAVEOUT
' Get ourselves set up for good coding practice
OPTION STATIC
OPTION EXPLICIT
' ------------------------------------------------------------------------------
' Set up any variables that will never change (they will stay constant)
' ------------------------------------------------------------------------------
CONST XRES=640
CONST YRES=480
CONST DXRES=160
CONST DYRES=120
CONST OFFX=240
CONST OFFY=180
CONST PI AS DOUBLE = 3.1415926535897932
CONST PIR AS DOUBLE = PI/180
' ------------------------------------------------------------------------------
' We need to set up a bunch of variables that can be used anywhere in the code
' ------------------------------------------------------------------------------
' Set up an array for our screen buffer
DIM SHARED AS UINTEGER DRAWBUFFER (XRES*YRES)
DIM SHARED AS UINTEGER DISPLAYBUFFER (XRES*YRES)
' Four colour variables that can be set with RGB() but encourage us to draw
' with only four colours at a time. Remember that the background is one
' of these as well
DIM SHARED AS UINTEGER C1, C2, C3, C4
#include "fontdata.bas"
DIM SHARED FONTMASK(4096*64) AS UINTEGER
DIM SHARED SCROLLTEXT AS STRING
DIM SHARED MP,MO AS INTEGER
DIM SHARED NUMSTARS AS INTEGER=24
DIM SHARED STARX(NUMSTARS) AS DOUBLE
DIM SHARED STARY(NUMSTARS) AS DOUBLE
DIM SHARED STARZ(NUMSTARS) AS DOUBLE
DIM SHARED TSTARX(NUMSTARS) AS DOUBLE
DIM SHARED TSTARY(NUMSTARS) AS DOUBLE
DIM SHARED TSTARZ(NUMSTARS) AS DOUBLE
DIM SHARED XROT AS INTEGER = 0
DIM SHARED YROT AS INTEGER = 0
DIM SHARED ZROT AS INTEGER = 0
DIM SHARED XROTO AS INTEGER = 3
DIM SHARED YROTO AS INTEGER = 2
DIM SHARED ZROTO AS INTEGER = 1
#include "SILVERBALL.BAS"
DIM SHARED SILVERBALLMASK(32*32) AS UINTEGER
DIM SHARED SINES(361) AS DOUBLE
DIM SHARED COSINES(361) AS DOUBLE
DIM SHARED PATTERN(64) AS UINTEGER
DIM SHARED NUMSQUARES AS UINTEGER=5
DIM SHARED SQUAREX(NUMSQUARES) AS INTEGER
DIM SHARED SQUAREXD(NUMSQUARES) AS INTEGER
DIM SHARED SQUAREY(NUMSQUARES) AS INTEGER
DIM SHARED SQUAREYD(NUMSQUARES) AS INTEGER
DIM SHARED SQUAREW(NUMSQUARES) AS INTEGER
DIM SHARED SQUAREH(NUMSQUARES) AS INTEGER
DIM SHARED SQUAREC(NUMSQUARES) AS INTEGER
' ------------------------------------------------------------------------------
' Now to declare which subroutines we are going to write
' ------------------------------------------------------------------------------
DECLARE SUB DRAW_STARS()
DECLARE SUB SCROLLER()
DECLARE SUB DRAWLETTER(byval image as uinteger ptr,byval mask as uinteger ptr,byval X as uinteger,byval Y as uinteger, byval HEIGHT as uinteger, byval LENGTH as uinteger)
DECLARE SUB DRAWPICTUREWITHMASK(byval image as uinteger ptr,byval mask as uinteger ptr,byval X as uinteger,byval Y as uinteger, byval HEIGHT as uinteger, byval LENGTH as uinteger)
DECLARE SUB MAKEMASK(byval image as uinteger ptr,byval mask as uinteger ptr,byval height as uinteger,byval length as uinteger)
DECLARE SUB MOVE_BALLS()
DECLARE SUB DRAW_SQUARES()
DECLARE SUB DITHER_SCREEN()
DECLARE SUB ROTCHANGE()
DECLARE SUB BUFFER_CONVERT(byval sourcebuffer as uinteger ptr,byval targetbuffer as uinteger ptr)
DECLARE SUB FOUR_COLOUR_SCREEN()
DECLARE SUB DOT(byval X AS INTEGER, byval Y AS INTEGER, byval COL AS INTEGER)
DECLARE SUB INIT()
INIT()
' ------------------------------------------------------------------------------
' Now we're ready to get going, let's try and open a screen. If it fails, there
' is no point in continuing
' ------------------------------------------------------------------------------
IF ( PTC_OPEN ( "Xal Base", XRES, YRES ) = 0 ) THEN
END -1
END IF
' ------------------------------------------------------------------------------
' We have our variables and arrays set up, we have an open screen display, so
' we can get going.
' ------------------------------------------------------------------------------
DIM SHARED BACKC AS UINTEGER=0
DIM SHARED BACKCD AS UINTEGER=1
DIM A,B,C AS UINTEGER
hWave = uFMOD_PlaySong(@music(0),40727,XM_MEMORY)
DO
ERASE DRAWBUFFER
BACKC+=BACKCD
IF BACKC>128 THEN
BACKCD=-1
BACKC=128
END IF
IF BACKC<64 THEN
BACKCD=1
BACKC=64
END IF
FOR A=0 TO 159
FOR B=0 TO 119
DOT(A,B,BACKC)
NEXT B
NEXT A
DRAW_SQUARES()
ROTCHANGE()
DRAW_STARS()
DITHER_SCREEN()
FOUR_COLOUR_SCREEN()
BUFFER_CONVERT(@DRAWBUFFER(0),@DISPLAYBUFFER(0))
PTC_UPDATE@DISPLAYBUFFER(0)
LOOP UNTIL INKEY$=CHR$(27)
' We're all done now, we pressed escape, time to finish things up
END
PTC_CLOSE()
SUB ROTCHANGE()
XROT=(XROT+XROTO) MOD 360
YROT=(YROT+YROTO) MOD 360
ZROT=(ZROT+ZROTO) MOD 360
END SUB
SUB DRAW_STARS()
DIM FOCUS, STAR, STARR, X, Y, Z, XX, YY, ZZ, COLOUR, DEPTH, STARA, STARB
DIM F, SCROLLED
FOCUS=500
SCROLLED=0
FOR STAR=0 TO NUMSTARS-1
X=STARX(STAR)
Y=STARY(STAR)
Z=STARZ(STAR)
' x rotation
XX=X
YY=Y*COSINES(XROT)+Z*SINES(XROT)
ZZ=Z*COSINES(XROT)-Y*SINES(XROT)
' y rotation
X=XX*COSINES(YROT)-ZZ*SINES(YROT)
Y=YY
Z=XX*SINES(YROT)+ZZ*COSINES(YROT)
' z rotation
XX=X*COSINES(ZROT)-Y*SINES(ZROT)
YY=X*SINES(ZROT)+Y*COSINES(ZROT)
ZZ=Z
' now we apply perspective
XX=XX/((ZZ/FOCUS)+1)
YY=YY/((ZZ/FOCUS)+1)
XX=INT(XX+OFFX+DXRES/2)
YY=INT(YY+OFFY+DYRES/2)
TSTARX(STAR)=XX
TSTARY(STAR)=YY
TSTARZ(STAR)=ZZ
NEXT
' bubble sort the stars
FOR STAR=0 TO NUMSTARS-2
FOR STARR=STAR+1 TO NUMSTARS-1
IF TSTARZ(STAR)<TSTARZ(STARR) THEN
X=TSTARX(STAR)
Y=TSTARY(STAR)
Z=TSTARZ(STAR)
TSTARX(STAR)=TSTARX(STARR)
TSTARY(STAR)=TSTARY(STARR)
TSTARZ(STAR)=TSTARZ(STARR)
TSTARX(STARR)=X
TSTARY(STARR)=Y
TSTARZ(STARR)=Z
END IF
NEXT STARR
NEXT STAR
' now actually draw the stars
FOR STAR=0 TO NUMSTARS-1
XX=TSTARX(STAR)
YY=TSTARY(STAR)
XX=XX-16
YY=YY-16
DRAWPICTUREWITHMASK(@SILVERBALLMASK(0),@SILVERBALLMASK(0),XX+4,YY+4,32,32)
DRAWPICTUREWITHMASK(@SILVERBALL(0),@SILVERBALLMASK(0),XX,YY,32,32)
IF SCROLLED=0 THEN
IF ABS(TSTARZ(STAR))<20 THEN
SCROLLER()
SCROLLED=1
END IF
END IF
NEXT
END SUB
' ------------------------------------------------------------------------------
' SCROLLER
'
' This is where we draw the scroller to the screen, although we'll jump out
' to another routine to draw the actual letter
' ------------------------------------------------------------------------------
SUB SCROLLER()
DIM L,C
' The letters are all the same width and because of this we know how many
' we can draw on the screen (5), so let's count from 0 to 4 and draw
' the appropriate letter
FOR L=0 TO 4
' Go and get the ASCII character of the appropriate letter in the
' scroller and subtract 32 from it to get a data offset
C=ASC(SCROLLTEXT,L+MP)-32
' Only draw a letter if it is not a space
IF C>0 THEN
DRAWLETTER(@FONTDATA(C*64),@FONTMASK(C*64),(L*54)-30-MO+4,44,64,64)
DRAWLETTER(@FONTMASK(C*64),@FONTMASK(C*64),(L*54)-30-MO,40,64,64)
END IF
NEXT
' Alter the scroller offset to move it across the screen. When we've moved
' far enough back (a whole letter width) we can move the message pointer
' along one. If we're now displaying the final part of the message, start
' again. This means that we need a bunch of spaces at the beginning and
' end of the message to make it scroll in and out smoothly
MO=MO+2
IF MO>=54 THEN
MO=MO-54
MP=MP+1
IF MP>LEN(SCROLLTEXT)-3 THEN MP=0
END IF
END SUB
SUB DRAWLETTER(byval image as uinteger ptr,byval mask as uinteger ptr,byval X as uinteger,byval Y as uinteger, byval HEIGHT as uinteger, byval LENGTH as uinteger)
DIM SCREENLENGTH
DIM PTRBUFF AS UINTEGER PTR
SCREENLENGTH=XRES-LENGTH
PTRBUFF=@DRAWBUFFER(X+OFFX+((Y+OFFY)*XRES))
asm
mov esi, [IMAGE]
mov edi, [PTRBUFF]
' load ax with the height for the yloop
mov ax, [height]
LYloop2:
push eax
' load BX with the screen width for the XLoop
mov bx,[length]
LXloop2:
push ebx
mov ebx,[esi]
mov eax,[edi]
xor eax,ebx
push esi
mov esi, [MASK]
mov ebx,[esi]
and eax,ebx
add esi,4
mov [MASK],esi
pop esi
mov ecx,[esi]
xor eax,ecx
and eax,255
' throw the value into the display buffer
mov [edi],eax
add edi,4
add esi,4
' still running the xloop?
pop ebx
dec bx
jnz LXloop2
' still running the yloop?
push esi
mov esi,[MASK]
add esi,16128
mov [MASK],esi
pop esi
mov ecx,[screenlength]
shl ecx,2
add edi,ecx
pop eax
dec ax
jnz LYloop2
end asm
end sub
SUB DRAW_SQUARES()
DIM X,Y,XD,YD,W,H,C,XX,YY,A
FOR A=0 TO NUMSQUARES-1
X=SQUAREX(A)
Y=SQUAREY(A)
W=SQUAREW(A)
H=SQUAREH(A)
C=SQUAREC(A)
XD=SQUAREXD(A)
YD=SQUAREYD(A)
X=X+XD
Y=Y+YD
IF X<-W OR X>DXRES THEN XD=-XD
IF Y<-H OR Y>DYRES THEN YD=-YD
SQUAREX(A)=X
SQUAREY(A)=Y
SQUAREXD(A)=XD
SQUAREYD(A)=YD
FOR YY=Y TO Y+H
FOR XX=X TO X+W
DOT(XX+2,YY+2,0)
DOT(XX,YY,C)
NEXT XX
NEXT YY
NEXT A
END SUB
SUB DITHER_SCREEN()
DIM X,Y,XX,YY,P,PP,PIX
FOR Y=0 TO DYRES-1
YY=Y MOD 8
FOR X=0 TO DXRES-1
XX=X MOD 8
PP=PATTERN(YY*8+XX)
P=(Y+OFFY)*XRES+X+OFFX
PIX=DRAWBUFFER(P)+PP
IF PIX>255 THEN PIX=255
PIX=PIX AND 192
PIX=PIX SHR 6
DRAWBUFFER(P)=PIX
NEXT X
NEXT Y
END SUB
SUB FOUR_COLOUR_SCREEN()
DIM P,X,Y,C AS UINTEGER
FOR Y=0 TO DYRES-1
FOR X=0 TO DXRES-1
P=(Y+OFFY)*XRES+X+OFFX
C=DRAWBUFFER(P)
IF C=0 THEN DRAWBUFFER(P)=C1
IF C=1 THEN DRAWBUFFER(P)=C2
IF C=2 THEN DRAWBUFFER(P)=C3
IF C=3 THEN DRAWBUFFER(P)=C4
NEXT X
NEXT Y
END SUB
SUB BUFFER_CONVERT(byval sourcebuffer as uinteger ptr,byval targetbuffer as uinteger ptr)
DIM HEIGHT,LENGTH AS UINTEGER
LENGTH=160
HEIGHT=120
SOURCEBUFFER=SOURCEBUFFER+(OFFY*XRES)+OFFX
asm
' now we have done the fire buffer, throw the results back
mov esi, [SOURCEBUFFER]
mov edi, [TARGETBUFFER]
' load ax with the height for the yloop
mov ax, [HEIGHT]
PYloop2:
push eax
' load BX with the screen width for the XLoop
mov bx,[LENGTH]
PXloop2:
push ebx
mov eax,[esi]
mov [edi],eax
mov [edi+4],eax
mov [edi+8],eax
mov [edi+12],eax
mov [edi+2560],eax
mov [edi+2564],eax
mov [edi+2568],eax
mov [edi+2572],eax
mov [edi+5120],eax
mov [edi+5124],eax
mov [edi+5128],eax
mov [edi+5132],eax
mov [edi+7680],eax
mov [edi+7684],eax
mov [edi+7688],eax
mov [edi+7692],eax
add edi,16
add esi,4
' still running the xloop?
pop ebx
dec bx
jnz PXloop2
add esi,1920
' still running the yloop?
add edi,7680
pop eax
dec ax
jnz PYloop2
end asm
end sub
' ------------------------------------------------------------------------------
' DOT
'
' If it is safe to do so, draw a single dot onto the screen buffer. You only
' need to use this routine if you can't trust the X and Y coordinates to be
' within the screen display.
' ------------------------------------------------------------------------------
SUB DOT(byval X AS INTEGER, byval Y AS INTEGER, byval C AS INTEGER)
IF X>=0 AND X<DXRES AND Y>=0 AND Y<DYRES THEN DRAWBUFFER(((Y+OFFY)*XRES)+OFFX+X)=C
END SUB
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Make Mask
'
' This creates an image mask for any image.
' The top left hand pixel of the image is
' used to determine the colour of the mask
' which means that it is essential to make
' sure it is not repeated in the image itself.
'
' A classic mistake is to use black, and also
' use black in the image. What you should do
' is ensure that true black is never used in
' the image if true black is used as the mask
' (or vice versa). Also, if you are creating
' your image in Photoshop, the edges will be
' blurred to the background colour, so pick
' a background colour that is close, but not
' the same, as the edge of your picture.
'
' Unless of course, you have drawn an image
' with intentional jagged black edges and
' want to use the now popular vibrant purple
' or green as a background.
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUB MAKEMASK(byval image as uinteger ptr,byval mask as uinteger ptr,byval height as uinteger,byval length as uinteger)
DIM MASKVALUE=RGB(255,255,255)
DIM MASKCOLOUR
asm
mov esi, [IMAGE]
mov eax,[esi]
mov [maskcolour],eax
mov edi, [MASK]
' load ax with the height for the yloop
mov ax, [height]
MYloop2:
push eax
' load BX with the screen width for the XLoop
mov bx,[length]
MXloop2:
push ebx
mov eax,[esi]
mov ebx,[maskcolour]
sub eax,ebx
jnz nomasking
mov eax,[maskvalue]
mov [edi],eax
nomasking:
add edi,4
add esi,4
' still running the xloop?
pop ebx
dec bx
jnz MXloop2
' still running the yloop?
pop eax
dec ax
jnz MYloop2
end asm
END SUB
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Draw picture with mask
'
' Using the mask we created from the image
' itself, draw the image onto the buffer.
' This routine is not clever, and doesn't
' clip at the edge of the buffer, so be
' careful. For my purpose, it's fine as I'm
' already bouncing the images when they get
' to the edge.
'
' If you wish to use the routine to slide
' images onto the screen, or throw images at
' the buffer without checking their position
' and size, then you'll need to put some
' additional code in. I'll probably make this
' change for my next project.
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUB DRAWPICTUREWITHMASK(byval image as uinteger ptr,byval mask as uinteger ptr,byval X as uinteger,byval Y as uinteger, byval HEIGHT as uinteger, byval LENGTH as uinteger)
DIM SCREENLENGTH
DIM PTRBUFF AS UINTEGER PTR
SCREENLENGTH=XRES-LENGTH
PTRBUFF=@DRAWBUFFER(X+(Y*XRES))
asm
mov esi, [IMAGE]
mov edi, [PTRBUFF]
' load ax with the height for the yloop
mov ax, [height]
QYloop2:
push eax
' load BX with the screen width for the XLoop
mov bx,[length]
QXloop2:
push ebx
mov ebx,[esi]
mov eax,[edi]
xor eax,ebx
push esi
mov esi, [MASK]
mov ebx,[esi]
and eax,ebx
add esi,4
mov [MASK],esi
pop esi
mov ecx,[esi]
xor eax,ecx
and eax,255
' throw the value into the display buffer
mov [edi],eax
add edi,4
add esi,4
' still running the xloop?
pop ebx
dec bx
jnz QXloop2
' still running the yloop?
mov ecx,[screenlength]
shl ecx,2
add edi,ecx
pop eax
dec ax
jnz QYloop2
end asm
end sub
' ------------------------------------------------------------------------------
' INIT
'
' This is where we will initialise all of our variables and arrays. It is
' kept at the end of the code to keep the front tidy
' ------------------------------------------------------------------------------
SUB INIT()
DIM A,X,Y,U,V,ANG,P,R,B,G,C,COL,LON,LAT AS INTEGER
FOR ANG=0 TO 360
SINES(ANG)=SIN(ANG*PIR)
COSINES(ANG)=COS(ANG*PIR)
NEXT
FOR A=0 TO 63
READ PATTERN(A)
NEXT A
makemask(@silverball(0),@silverballmask(0),32,32)
makemask(@fontdata(0),@fontmask(0),64,4096)
FOR A=0 TO NUMSQUARES-1
SQUAREX(A)=INT(RND*DXRES)
SQUAREXD(A)=INT(RND*2)-1
IF SQUAREXD(A)=0 THEN SQUAREXD(A)=1
SQUAREY(A)=INT(RND*DYRES)
SQUAREYD(A)=INT(RND*2)-1
IF SQUAREYD(A)=0 THEN SQUAREYD(A)=1
SQUAREW(A)=INT(RND*40)+30
SQUAREH(A)=INT(RND*40)+30
SQUAREC(A)=INT(RND*192)
NEXT A
' Let's start by reading the cube data
FOR A=0 TO NUMSTARS-1
IF A<12 THEN
LON=90
LAT=A*30
ELSE
LON=(A-12)*30
LAT=90
END IF
STARX(A)=INT(SIN(LON*(PI/180))*SIN(LAT*(PI/180))*60)
STARY(A)=INT(SIN(LON*(PI/180))*COS(LAT*(PI/180))*60)
STARZ(A)=INT(COS(LON*(PI/180))*60)
NEXT
SCROLLTEXT = " "
SCROLLTEXT += "HELLO, XALTHORN HERE WITH A LOW RESOLUTION, LIMITED COLOUR "
SCROLLTEXT += "DEMO. IT'S BEEN AN INTERESTING EXPERIMENT AND I'VE DABBLED "
SCROLLTEXT += "IN THINGS I'VE NEVER DONE BEFORE. THE DITHERING IS NEW FOR "
SCROLLTEXT += "ME AND IT WAS AN INTERESTING TIME RESEARCHING HOW IT ALL "
SCROLLTEXT += "WORKS. "
SCROLLTEXT += "THIS IS ALSO THE FIRST TIME I'VE DONE A SCROLLER USING "
SCROLLTEXT += "IMAGES FOR THE LETTERS. ALL IN ALL, IT'S BEEN FUN. "
SCROLLTEXT += "ANYWAY, A QUICK SHOUT TO ALL THE FOLKS ON THE DBF FORUMS, "
SCROLLTEXT += "LET'S SEE WHAT YOU FOLKS PRODUCE FOR THIS FUN CHALLENGE. "
SCROLLTEXT += "THE TUNE YOU ARE LISTENING TO IS CALLED ""2 X THE "
SCROLLTEXT += "SQUAREBEAM"" BY ANDERS DATOR FELIX DATOR AND WAS DOWNLOADED "
SCROLLTEXT += "FROM MODARCHIVE.ORG."
SCROLLTEXT += " "
C1=RGB(0,0,0)
C2=RGB(0,0,140)
C3=RGB(0,0,180)
C4=RGB(150,100,30)
END SUB
' Bayer dither pattern
DATA 0,32, 8,40, 2,34,10,42
DATA 48,16,56,24,50,18,58,26
DATA 12,44, 4,36,14,46, 6,38
DATA 60,28,52,20,62,30,54,22
DATA 3,35,11,43, 1,33, 9,41
DATA 51,19,59,27,49,17,57,25
DATA 15,47, 7,39,13,45, 5,37
DATA 63,31,55,23,61,29,53,21
