Code: Select all
REM ACETAMINOPHEN v3
REM You'll need some afterwards
REM iPhone 6 plus / iOS 8.4 B1
REM v2 - optimized using Mr. K's advice!
REM v3 - used 4.8 tri and quad commands
REM enjoy
REM the shapes in the blue
REM to get a cool effect!!
def reload
notes load "/Examples/10. Music & Sound/files/test5.mid"
notes play
enddef
reload
graphics
'Program Notes: This demo started life as a wire frame
'3D routine that I developed to model a simple 3D cube....
'My previous 3D had depth sorted faces, this one uses a
'hidden line algorithm that checks if the points of a given
'face are in clockwise or
'anticlockwise order to see if they should
'be drawn.... I Added some light sourcing
'to the cube, and borrowed an idea from
'my other demos.
'Set Everything up
GOSUB initialize
refresh off
option screenlock off
dgc=0.01
dgcr=dgc!dgcg=dgc!dgcb=dgc
gcr=0!gcg=.33!gcb=.66
' Main Loop
loop:
if notes_time()>notes_length() then reload
'Draw Backround
gcr+=dgcr!gcg+=dgcg!gcb+=dgcb
if gcr>1 or gcr<0 then dgcr=-dgcr
if gcg>1 or gcg<0 then dgcg=-dgcg
if gcb>1 or gcb<0 then dgcb=-dgcb
graphics clear gcr,gcg,gcb
'Call Rotation Routine
GOSUB rotate
'Draw Inside Faces
'Color 10,30,10
f1=1
f2=2
f3=3
f4=4 'Face 1
GOSUB draw 'Draw Face 1
f1=5
f2=8
f3=7
f4=6 'Face 2
GOSUB draw 'Draw Face 2
f1=6
f2=2
f3=1
f4=5 'Face 3
GOSUB draw 'Draw Face 3
f1=8
f2=4
f3=3
f4=7 ' Face 4
GOSUB draw 'Draw Face 4
f1=2
f2=6
f3=7
f4=3 'Face 5
GOSUB draw 'Draw Face 5
f1=8
f2=5
f3=1
f4=4 'Face 6
GOSUB draw 'Draw Face 6
' Draw Outside Faces
f1=1
f2=2
f3=3
f4=4 'Face 1
GOSUB draw2 'Draw Face 1
f1=5
f2=8
f3=7
f4=6 'Face 2
GOSUB draw2 'Draw Face 2
f1=6
f2=2
f3=1
f4=5 'Face 3
GOSUB draw2 'Draw Face 3
f1=8
f2=4
f3=3
f4=7 'Face 4
GOSUB draw2 'Draw Face 4
f1=2
f2=6
f3=7
f4=3 'Face 5
GOSUB draw2 'Draw Face 5
f1=8
f2=5
f3=1
f4=4 'Face 6
GOSUB draw2 'Draw Face 6
'Display Text
stext$=substr$(s$,p,len(s$)-1)
draw COLOR 0,0,0
DRAW TEXT "ACETAMINOPHEN" at 0,2
DRAW TEXT stext$ at scx+2,sch-18
draw COLOR 1,1,1
DRAW TEXT "ACETAMINOPHEN" at 0,0
'DRAW TEXT stext$ at scx,sch-20
'Scroller Code
ls=len(s$)-1
text$=substr$(s$,p,ls)
draw color 0,0,0
draw text text$ at scx+2,sh-18+rnd(2)
draw color 1,1,1
draw text text$ at scx,sh-20+rnd(2)
'draw text substr$(s$,p,ls) at scx,texty
scx-=3
if scx<-50 then
scx+=10
p+=1
if p>ls then p=1
end if
GOSUB writer
refresh
GOTO loop
'Main Loop Ends
'Subroutines
'This Subroutine Does The Bouncy Greetings Thing;
writer:
mm=mm+.05
IF mm>4 THEN
mm=0
mc=mc+1
IF mc>messages THEN
mc=1
END IF
END IF
draw COLOR 1,1,1
DRAW TEXT m$(mc) at csw-LEN(m$(mc))*5,70*SIN(mm)
RETURN
'Subroutine To Draw One Inner Face From 4 Passed Points
'This Will Only Draw The Face If It Is Behind.
draw:
'Calculate Poly Positions And Draw One Complete Face
'Hidden Line Removal Algorithm
vx1= tx(f1)-tx(f2)
vy1= ty(f1)-ty(f2)
vx2= tx(f3)-tx(f2)
vy2= ty(f3)-ty(f2)
IF (vx1*vy2)-(vx2*vy1)>0 THEN
'Lightsource Color
light=(tz(1)+tz(f2)+tz(f3)+tz(f4)*3)
' light=light+50
fill COLOR 0,0,light/255
'Draw Background of face (blue)
fill tri tx(f1),ty(f1), tx(f2),ty(f2), tx(f3),ty(f3)
fill tri tx(f1),ty(f1), tx(f4),ty(f4), tx(f3),ty(f3)
'Calculate Non Defined Co-Ordinates.
xt=(tx(f1)+tx(f2))/2 'Find Top Centre X
yt=(ty(f1)+ty(f2))/2 'Find Top Centre y
cx(1)=(xt+tx(f1))/2 'Calculate xpos 1
cy(1)=(yt+ty(f1))/2 'Calculate Ypos 1
cx(2)=(xt+tx(f2))/2 'Calculate xpos 2
cy(2)=(yt+ty(f2))/2 'Calculate Ypos 2
xt=(tx(f2)+tx(f3))/2 'Find side Centre X
yt=(ty(f2)+ty(f3))/2 'Find side Centre y
cx(3)=(xt+tx(f2))/2 'Calculate xpos 3
cy(3)=(yt+ty(f2))/2 'Calculate Ypos 3
cx(4)=(xt+tx(f3))/2 'Calculate xpos 4
cy(4)=(yt+ty(f3))/2 'Calculate Ypos 4
xt=(tx(f3)+tx(f4))/2 'Find bottom Centre X
yt=(ty(f3)+ty(f4))/2 'Find bottom Centre y
cx(5)=(xt+tx(f3))/2 'Calculate xpos 5
cy(5)=(yt+ty(f3))/2 'Calculate Ypos 5
cx(6)=(xt+tx(f4))/2 'Calculate xpos 6
cy(6)=(yt+ty(f4))/2 'Calculate Ypos 6
xt=(tx(f4)+tx(f1))/2 'Find side Centre X
yt=(ty(f4)+ty(f1))/2 'Find side Centre y
cx(7)=(xt+tx(f4))/2 'Calculate xpos 7
cy(7)=(yt+ty(f4))/2 'Calculate Ypos 7
cx(8)=(xt+tx(f1))/2 'Calculate xpos 8
cy(8)=(yt+ty(f1))/2 'Calculate Ypos 8
xt=(cx(1)+cx(6))/2 'Find side offset Centre 1
yt=(cy(1)+cy(6))/2 'Find side offset Centre 1
cx(9)=(xt+cx(1))/2 'Calculate xpos 9
cy(9)=(yt+cy(1))/2 'Calculate Ypos 9
cx(10)=(xt+cx(6))/2 'Calculate xpos 10
cy(10)=(yt+cy(6))/2 'Calculate Ypos 10
xt=(cx(2)+cx(5))/2 'Find side offset Centre 2
yt=(cy(2)+cy(5))/2 'Find side offset Centre 2
cx(11)=(xt+cx(2))/2 'Calculate xpos 11
cy(11)=(yt+cy(2))/2 'Calculate Ypos 11
cx(12)=(xt+cx(5))/2 'Calculate xpos 12
cy(12)=(yt+cy(5))/2 'Calculate Ypos 12
'Draw Red Polygons
fill COLOR light/255,0,0
fill tri tx(f1),ty(f1), cx(1),cy(1), cx(9),cy(9)
fill tri tx(f1),ty(f1), cx(9),cy(9), cx(8),cy(8)
fill tri tx(f2),ty(f2), cx(2),cy(2), cx(11),cy(11)
fill tri tx(f2),ty(f2), cx(11),cy(11), cx(3),cy(3)
'fill tri tx(f3),ty(f3), cx(4),cy(4), cx(12),cy(12)
fill quad tx(f3),ty(f3), cx(4),cy(4),cx(12),cy(12), cx(5),cy(5)
fill tri tx(f4),ty(f4), cx(6),cy(6), cx(10),cy(10)
fill tri tx(f4),ty(f4), cx(10),cy(10), cx(7),cy(7)
' Draw The Green Polygons
fill COLOR 0,light/255,0
fill tri cx(9),cy(9), cx(10),cy(10), cx(11),cy(11)
fill tri cx(12),cy(12), cx(11),cy(11), cx(10),cy(10)
'Draw Red Tron Lines
draw COLOR 1,0,0
draw LINE tx(f1),ty(f1) to tx(f2),ty(f2)
draw LINE tx(f2),ty(f2) to tx(f3),ty(f3)
draw LINE tx(f3),ty(f3) to tx(f4),ty(f4)
draw LINE tx(f4),ty(f4) to tx(f1),ty(f1)
draw LINE cx(1),cy(1) to cx(6),cy(6)
draw LINE cx(2),cy(2) to cx(5),cy(5)
draw LINE cx(3),cy(3) to cx(8),cy(8)
draw LINE cx(4),cy(4) to cx(7),cy(7)
END IF
RETURN
'Subroutine To Draw One Outer Face From 4 Passed Points
'This Wil Only Draw The Face If It Is In Front.
draw2:
' Calculate Poly Positions And Draw One Complete Face
'Hidden Line Removal Algorithm
'watch this will be in my writings
vx1= tx(f1)-tx(f2)
vy1= ty(f1)-ty(f2)
vx2= tx(f3)-tx(f2)
vy2= ty(f3)-ty(f2)
IF (vx1*vy2)-(vx2*vy1)<0 THEN
'Lightsource Color
light=-(tz(1)+tz(f2)+tz(f3)+tz(f4))*5
light=light+50
fill COLOR 0,0,light/255
'Draw Background of face (blue)
'comment the shape yo see a cool efx!
'' fill tri tx(f1),ty(f1), tx(f2),ty(f2), tx(f3),ty(f3)
'comment the SHAPE to see a cool efx!
'' fill tri tx(f1),ty(f1), tx(f4),ty(f4), tx(f3),ty(f3)
'Calculate Non Defined Co-Ordinates.
xt=(tx(f1)+tx(f2))/2 'Find Top Centre X
yt=(ty(f1)+ty(f2))/2 'Find Top Centre y
cx(1)=(xt+tx(f1))/2 'Calculate xpos 1
cy(1)=(yt+ty(f1))/2 'Calculate Ypos 1
cx(2)=(xt+tx(f2))/2 'Calculate xpos 2
cy(2)=(yt+ty(f2))/2 'Calculate Ypos 2
xt=(tx(f2)+tx(f3))/2 'Find side Centre X
yt=(ty(f2)+ty(f3))/2 'Find side Centre y
cx(3)=(xt+tx(f2))/2 'Calculate xpos 3
cy(3)=(yt+ty(f2))/2 'Calculate Ypos 3
cx(4)=(xt+tx(f3))/2 'Calculate xpos 4
cy(4)=(yt+ty(f3))/2 'Calculate Ypos 4
xt=(tx(f3)+tx(f4))/2 'Find bottom Centre X
yt=(ty(f3)+ty(f4))/2 'Find bottom Centre y
cx(5)=(xt+tx(f3))/2 'Calculate xpos 5
cy(5)=(yt+ty(f3))/2 'Calculate Ypos 5
cx(6)=(xt+tx(f4))/2 'Calculate xpos 6
cy(6)=(yt+ty(f4))/2 'Calculate Ypos 6
xt=(tx(f4)+tx(f1))/2 'Find side Centre X
yt=(ty(f4)+ty(f1))/2 'Find side Centre y
cx(7)=(xt+tx(f4))/2 'Calculate xpos 7
cy(7)=(yt+ty(f4))/2 'Calculate Ypos 7
cx(8)=(xt+tx(f1))/2 'Calculate xpos 8
cy(8)=(yt+ty(f1))/2 'Calculate Ypos 8
xt=(cx(1)+cx(6))/2 'Find side offset Centre 1
yt=(cy(1)+cy(6))/2 'Find side offset Centre 1
cx(9)=(xt+cx(1))/2 'Calculate xpos 9
cy(9)=(yt+cy(1))/2 'Calculate Ypos 9
cx(10)=(xt+cx(6))/2 'Calculate xpos 10
cy(10)=(yt+cy(6))/2 'Calculate Ypos 10
xt=(cx(2)+cx(5))/2 'Find side offset Centre 2
yt=(cy(2)+cy(5))/2 'Find side offset Centre 2
cx(11)=(xt+cx(2))/2 'Calculate xpos 11
cy(11)=(yt+cy(2))/2 'Calculate Ypos 11
cx(12)=(xt+cx(5))/2 'Calculate xpos 12
cy(12)=(yt+cy(5))/2 'Calculate Ypos 12
'Draw Red Polygons
fill COLOR light/255,0,0
fill tri tx(f1),ty(f1), cx(1),cy(1), cx(9),cy(9)
fill tri tx(f1),ty(f1), cx(9),cy(9), cx(8),cy(8)
fill tri tx(f2),ty(f2), cx(2),cy(2), cx(11),cy(11)
fill tri tx(f2),ty(f2), cx(11),cy(11), cx(3),cy(3)
fill tri tx(f3),ty(f3), cx(4),cy(4), cx(12),cy(12)
fill tri tx(f3),ty(f3), cx(12),cy(12), cx(5),cy(5)
fill tri tx(f4),ty(f4), cx(6),cy(6), cx(10),cy(10)
fill tri tx(f4),ty(f4), cx(10),cy(10), cx(7),cy(7)
'Draw The Green Polygons
fill COLOR 0,light/255,0
fill tri cx(9),cy(9), cx(11),cy(11), cx(10),cy(10)
fill tri cx(12),cy(12), cx(11),cy(11), cx(10),cy(10)
'Black Lines
draw COLOR 40/255,110/255,150/255
draw LINE tx(f1),ty(f1) to tx(f2),ty(f2)
draw LINE tx(f2),ty(f2) to tx(f3),ty(f3)
draw LINE tx(f3),ty(f3) to tx(f4),ty(f4)
draw LINE tx(f4),ty(f4) to tx(f1),ty(f1)
draw LINE cx(1),cy(1) to cx(6),cy(6)
draw LINE cx(2),cy(2) to cx(5),cy(5)
draw LINE cx(3),cy(3) to cx(8),cy(8)
draw LINE cx(4),cy(4) to cx(7),cy(7)
END IF
RETURN
'This Subroutine Rotates The Eight Corner Points About
'Thier X,Y and Z Axis Using Matrices And Applys A
'Perspective Formula To The Transformed Points.
'All Logical Points are derived from these 8.
rotate:
'Rotate And Scale Each Point - Store Result
FOR a=1 TO polys
x1=x(a)
y1=y(a)
z1=z(a)
'X,Y,Z rotations!
xx=x1
yy=y1*cs(xr)+z1*sn(xr)
zz=z1*cs(xr)-y1*sn(xr)
y1=yy
x1=xx*cs(yr)-zz*sn(yr)
z1=xx*sn(yr)+zz*cs(yr)
zz=z1
xx=x1*cs(zr)-y1*sn(zr)
yy=x1*sn(zr)+y1*cs(zr)
'Apply Perspective!
xx=size*(xx/((zz/50)+1))+sw/2
yy=size*(yy/((zz/50)+1))+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
NEXT a
' Incriment Rotations!
xr=xr+3
yr=yr+2
zr=zr+1
IF xr>720 THEN
xr=xr-720
END IF
IF yr>720 THEN
yr=yr-720
END IF
IF zr>720 THEN
zr=zr-720
END IF
RETURN
initialize:
sw=Screen_Width()
sh=Screen_Height()
csw=sw/2
csh=sh/2
pi = 3.1415
' This Sub-Routine Initializes The Program.
'Scroll Variables
s$=" "
s$=s$&"CAN YOU GUESS WHY THIS IS CALLED THE ACETAMINOPHEN"
s$=s$&"??? NO??? WELL WATCH IT FOR HALF AN HOUR "
s$=s$&"AND YOU'LL FIND OUT THE HARD WAY.... GUARANTEED"
s$=s$&" TO CAUSE A BLINDING HEADACHE... I TRIED TO MAKE "
s$=s$&"SOMETHING COLORFUL. "
p=0
scx=0
' Writer Variables
messages=18 ' How Many text lines?
mc=1
DIM m$(messages+2) 'Set Space For Them
FOR a=1 TO messages 'Read Them In
READ m$(a)
NEXT a
'Define the necessary variables!
size=12 'how big do you want it?
polys=8 'The amount of vertices in the object
DIM x(polys+1) 'Original X co-ordinate store
DIM y(polys+1) 'Original Y co-ordinate store
DIM z(polys+1) 'Original Z co-ordinate store
DIM tx(polys+1) 'Transformed X co-ordinate store
DIM ty(polys+1) 'Transformed Y co-ordinate store
DIM tz(polys+1) 'Transformed Z co-ordinate store
DIM cx(13) ' Storage For Calculated X
DIM cy(13) ' Storage For Calculated Y
DIM trix(4),triy(4) ' triangle
xr=3
yr=2
zr=1
'Define Sine Tables!!
DIM cs(722)
DIM sn(722)
FOR ang=0 TO 720
cs(ang)=COS(ang*(PI/360))
sn(ang)=SIN(ang*(PI/360))
NEXT ang
' Read in the object!
FOR a=1 TO polys
READ x(a),y(a),z(a)
NEXT a
text:
DATA "WELCOME TO","ACETAMINOPHEN v3"
DATA "BY DR. CHIP!","3D MANIPULATION"
DATA "MULTI MESSAGES","PRECALCULATED MATH"
DATA "HIDDEN LINES","3D ROTATIONS"
DATA "TRON COLORS!","SMART BASIC 4.8!"
DATA "HI TO:","DUTCHMAN"
DATA "OPERATOR","DIGIT"
DATA "MR K.","BILL BEST"
DATA "RED SECTOR INC","FORUM MEMBERS!"
' The Object Description As Data!
' The Data Below Describes A Cube.
obj:
DATA -10,10,10,10,10,10,10,-10,10,-10,-10,10
DATA -10,10,-10,10,10,-10,10,-10,-10,-10,-10,-10
RETURN
