The DB Classic Programming Challenge Thread

Author

Message

TDK

Retired Moderator

23

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 14th Oct 2007 00:54 Edited at: 14th Oct 2007 00:56

Link

Don't forget that in my program I'm viewing the dice from the front. Are you?

If my program didn't work I wouldn't have posted it!

It does display six random dice sides right?

TDK_Man

* TDK's Game Programming Forums - Open To All - DB & Team Request Boards *

Back to top

Profile PM Email Website

Binary Coder

19

Years of Service

User Offline

Joined: 26th Feb 2007

Location: Queensland, Australia

Posted: 14th Oct 2007 01:37

Link

Congrats TDK!

Hmm... This is a bit baffling, i can't think of anything creative!

Back to top

Profile PM Email

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 14th Oct 2007 03:25

Link

@TDK
aaaaah you're making me do 3D man!
haha jk I'll handle it

Something original with dice? YAHTZEE! that was pretty original

Back to top

Profile PM Email

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 14th Oct 2007 11:12 Edited at: 14th Oct 2007 11:33

Link

Quote: "Don't forget that in my program I'm viewing the dice from the front. Are you?"

Aaah, there goes any reputation of intelligence that I may ever have had.
Thanks TDK.

EDIT: Ok, with that II can basically give in my entry. It's an example really, not a game, 'cause 3D and visuals are my strong point, not the basic stuff like variables and arrays and that sort of thing. I may work on this later.

hide mouse
  AutoCam Off
  Sync On
  Sync Rate 30
  CLS 0
  Dim DScore(2)
  Randomize Timer()
  True = 1: False = 0
gosub images
Gosub Setup

f#=50

repeat
  xrotate object 1,wrapvalue(object angle x(1)-11)
  xrotate object 2,wrapvalue(object angle x(2)+12)
  Position Object 1,0.6,f#,0
  Position Object 2,-0.6,f#,0
  point camera 0,f#,0
  f#=f#-0.4
  Sync
until f#<0
wait 500
for t=0 to 4
position object 1,t,0,0
position object 2,t,0,0
position object 3,t,0,0
sync
next t
for t=4 to -4 step -1
position object 1,t,0,0
position object 2,t,0,0
position object 3,t,0,0
sync
next t
for t=-4 to 0 
position object 1,t,0,0
position object 2,t,0,0
position object 3,t,0,0
sync
next t
wait 500

for t=0 to 120
zrotate object 3,t
position object 1,tp#,0,0
position object 2,tp#,0,0
position object 3,tp#,0,0
inc tp#,0.02
sync
next t
gggg:
rotate object 1,0,0,0
rotate object 2,0,0,0
For N=1 To 2
        DScore(N)=Rnd(5)+1: Rem Random dice face chosen
        Select DScore(N)
          Case 1: Rotate Object N,0,90,0: EndCase
          Case 2: Rotate Object N,0,180,0: EndCase
          Case 3: Rotate Object N,90,0,0: EndCase
          Case 4: Rotate Object N,270,0,0: EndCase
          Case 5: Rotate Object N,0,0,0: EndCase
          Case 6: Rotate Object N,0,270,0: EndCase
        EndSelect
      Next N
        DScore1=DScore(1)
        DScore2=DScore(2)

position object 1,-1,0,0
position object 2,0,0,0

c#=1
dh#=1
for t=0 to 40
dec c#,0.1
position object 1,c#-1,dh#,0
position object 2,c#,dh#,0
dec dh#,0.1
sync
next t

ink rgb(255,255,255),0
repeat
set cursor 0,0
print "You got ",DScore1," and ",DScore2,". Please press space."
sync
until spacekey()=1

End

images:
ink rgb(255,0,0),0
box 0,0,300,300
ink rgb(190,0,0),0
for t=0 to 9000
a=rnd(300)
b=rnd(300)
box a,b,a,b
next t
get image 1,0,0,300,300
cls
ink rgb(0,120,0),0
box 0,0,300,300
ink rgb(0,150,20),0
for t=0 to 6000
a=rnd(300)
b=rnd(300)
box a,b,a,b
next t
get image 2,0,0,300,300
cls
ink rgb(255,255,255),0
for t=0 to 2000
a=rnd(500)
b=rnd(400)
box a,b,a,b
next t
get image 3,0,0,500,400
cls
return

Setup:

MakeDice(2,1,1.0)
  Position Object 1,0.6,3,0
  Position Object 2,-0.6,3,0
  Position Camera 0,0,-10
  make object cylinder 3,5
  texture object 3,1
  make object box 4,500,4,500
  position object 4,0,-6.5,0
  texture object 4,2
  make object sphere 5,5000
  texture object 5,3 
  set object 5,1,1,0
Return

Function MakeDice(NumDice,StartObjNumber,DiceSize#)
  Create Bitmap 1,800,600
  CLS RGB(85,0,0)
  Rem Number One
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 128,128,N: Circle 128,129,N
  Next N
  Get Image 1001,0,0,256,256
  Rem Number Two
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1002,0,0,256,256
  Rem Number Three
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1003,0,0,256,256
  Rem Number Four
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1004,0,0,256,256
  Rem Number Five
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1005,0,0,256,256
  Rem Number Six
  Ink RGB(200,200,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,128,N: Circle 46,129,N
    Circle 208,128,N: Circle 208,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1006,0,0,256,256
  Set Current Bitmap 0
  Delete Bitmap 1
  For ObjNum = StartObjNumber To StartObjNumber+(NumDice-1)
    Offset#=DiceSize#/2.0: MeshNum=2000: PlainNum=2000
    Make Object Cube ObjNum,DiceSize#
    Make Object Plain PlainNum,DiceSize#,DiceSize#
    Make Mesh From Object MeshNum,PlainNum
    ADD LIMB ObjNum,1,2000: Offset Limb ObjNum,1,0,0,0.0-Offset#: Rem Cube Side 1 (Front)
    ADD LIMB ObjNum,2,2000: Rotate Limb ObjNum,2,0,90,0: Offset Limb ObjNum,2,0.0-Offset#,0,0: Rem Cube Side 2 (Left)
    ADD LIMB ObjNum,3,2000: Rotate Limb ObjNum,3,0,180,0: Offset Limb ObjNum,3,0,0,Offset#:  Rem Cube Side 3 (Back)
    ADD LIMB ObjNum,4,2000: Rotate Limb ObjNum,4,0,270,0: Offset Limb ObjNum,4,Offset#,0,0:  Rem Cube Side 4 (Right)
    ADD LIMB ObjNum,5,2000: Rotate Limb ObjNum,5,270,0,0: Offset Limb ObjNum,5,0,0.0-Offset#,0: Rem Cube Side 5 (Bottom)
    ADD LIMB ObjNum,6,2000: Rotate Limb ObjNum,6,90,0,0: Offset Limb ObjNum,6,0,Offset#,0: Rem Cube Side 6 (Top)
    Delete Mesh MeshNum
    Delete Object PlainNum
    Hide Limb ObjNum,0
    Texture LIMB ObjNum,1,1005: Texture LIMB ObjNum,2,1006
    Texture LIMB ObjNum,3,1002: Texture LIMB ObjNum,4,1001
    Texture LIMB ObjNum,5,1003: Texture LIMB ObjNum,6,1004
  Next ObjNum
EndFunction

+ Code Snippet

  hide mouse
  AutoCam Off
  Sync On
  Sync Rate 30
  CLS 0
  Dim DScore(2)
  Randomize Timer()
  True = 1: False = 0
gosub images
Gosub Setup

f#=50


repeat
  xrotate object 1,wrapvalue(object angle x(1)-11)
  xrotate object 2,wrapvalue(object angle x(2)+12)
  Position Object 1,0.6,f#,0
  Position Object 2,-0.6,f#,0
  point camera 0,f#,0
  f#=f#-0.4
  Sync
until f#<0
wait 500
for t=0 to 4
position object 1,t,0,0
position object 2,t,0,0
position object 3,t,0,0
sync
next t
for t=4 to -4 step -1
position object 1,t,0,0
position object 2,t,0,0
position object 3,t,0,0
sync
next t
for t=-4 to 0 
position object 1,t,0,0
position object 2,t,0,0
position object 3,t,0,0
sync
next t
wait 500

for t=0 to 120
zrotate object 3,t
position object 1,tp#,0,0
position object 2,tp#,0,0
position object 3,tp#,0,0
inc tp#,0.02
sync
next t
gggg:
rotate object 1,0,0,0
rotate object 2,0,0,0
For N=1 To 2
        DScore(N)=Rnd(5)+1: Rem Random dice face chosen
        Select DScore(N)
          Case 1: Rotate Object N,0,90,0: EndCase
          Case 2: Rotate Object N,0,180,0: EndCase
          Case 3: Rotate Object N,90,0,0: EndCase
          Case 4: Rotate Object N,270,0,0: EndCase
          Case 5: Rotate Object N,0,0,0: EndCase
          Case 6: Rotate Object N,0,270,0: EndCase
        EndSelect
      Next N
        DScore1=DScore(1)
        DScore2=DScore(2)


position object 1,-1,0,0
position object 2,0,0,0

c#=1
dh#=1
for t=0 to 40
dec c#,0.1
position object 1,c#-1,dh#,0
position object 2,c#,dh#,0
dec dh#,0.1
sync
next t


ink rgb(255,255,255),0
repeat
set cursor 0,0
print "You got ",DScore1," and ",DScore2,". Please press space."
sync
until spacekey()=1

End





images:
ink rgb(255,0,0),0
box 0,0,300,300
ink rgb(190,0,0),0
for t=0 to 9000
a=rnd(300)
b=rnd(300)
box a,b,a,b
next t
get image 1,0,0,300,300
cls
ink rgb(0,120,0),0
box 0,0,300,300
ink rgb(0,150,20),0
for t=0 to 6000
a=rnd(300)
b=rnd(300)
box a,b,a,b
next t
get image 2,0,0,300,300
cls
ink rgb(255,255,255),0
for t=0 to 2000
a=rnd(500)
b=rnd(400)
box a,b,a,b
next t
get image 3,0,0,500,400
cls
return




Setup:

  MakeDice(2,1,1.0)
  Position Object 1,0.6,3,0
  Position Object 2,-0.6,3,0
  Position Camera 0,0,-10
  make object cylinder 3,5
  texture object 3,1
  make object box 4,500,4,500
  position object 4,0,-6.5,0
  texture object 4,2
  make object sphere 5,5000
  texture object 5,3 
  set object 5,1,1,0
Return





Function MakeDice(NumDice,StartObjNumber,DiceSize#)
  Create Bitmap 1,800,600
  CLS RGB(85,0,0)
  Rem Number One
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 128,128,N: Circle 128,129,N
  Next N
  Get Image 1001,0,0,256,256
  Rem Number Two
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1002,0,0,256,256
  Rem Number Three
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1003,0,0,256,256
  Rem Number Four
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1004,0,0,256,256
  Rem Number Five
  Ink RGB(255,255,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1005,0,0,256,256
  Rem Number Six
  Ink RGB(200,200,255),0: Box 2,2,254,254
  Ink RGB(0,0,0),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,128,N: Circle 46,129,N
    Circle 208,128,N: Circle 208,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1006,0,0,256,256
  Set Current Bitmap 0
  Delete Bitmap 1
  For ObjNum = StartObjNumber To StartObjNumber+(NumDice-1)
    Offset#=DiceSize#/2.0: MeshNum=2000: PlainNum=2000
    Make Object Cube ObjNum,DiceSize#
    Make Object Plain PlainNum,DiceSize#,DiceSize#
    Make Mesh From Object MeshNum,PlainNum
    ADD LIMB ObjNum,1,2000: Offset Limb ObjNum,1,0,0,0.0-Offset#: Rem Cube Side 1 (Front)
    ADD LIMB ObjNum,2,2000: Rotate Limb ObjNum,2,0,90,0: Offset Limb ObjNum,2,0.0-Offset#,0,0: Rem Cube Side 2 (Left)
    ADD LIMB ObjNum,3,2000: Rotate Limb ObjNum,3,0,180,0: Offset Limb ObjNum,3,0,0,Offset#:  Rem Cube Side 3 (Back)
    ADD LIMB ObjNum,4,2000: Rotate Limb ObjNum,4,0,270,0: Offset Limb ObjNum,4,Offset#,0,0:  Rem Cube Side 4 (Right)
    ADD LIMB ObjNum,5,2000: Rotate Limb ObjNum,5,270,0,0: Offset Limb ObjNum,5,0,0.0-Offset#,0: Rem Cube Side 5 (Bottom)
    ADD LIMB ObjNum,6,2000: Rotate Limb ObjNum,6,90,0,0: Offset Limb ObjNum,6,0,Offset#,0: Rem Cube Side 6 (Top)
    Delete Mesh MeshNum
    Delete Object PlainNum
    Hide Limb ObjNum,0
    Texture LIMB ObjNum,1,1005: Texture LIMB ObjNum,2,1006
    Texture LIMB ObjNum,3,1002: Texture LIMB ObjNum,4,1001
    Texture LIMB ObjNum,5,1003: Texture LIMB ObjNum,6,1004
  Next ObjNum
EndFunction

Back to top

Profile PM

Tone3e

19

Years of Service

User Offline

Joined: 17th Feb 2007

Location: here

Posted: 14th Oct 2007 21:26

Link

Are we allowed to change up the function abit. I have an idea for this challenge, but i am not sure i will be able to do it. My idea was taken from a mario party 5 minigame. fist the opponent goes up and hit three dice, one at a time. The middle dice is a +,-,*, or / sign and the two on the end are numbers. The results are added up and then the player goes and does the same thing. The won with the highest result wins. Other people are welcome to try this idea as i may have trouble along the way cause i am a noob, sort of, and if others are doing this they can help me figure some thigs out on the way. Great challenge TDK. I think its easy enough to do, and i can learn from it. If i cant advance on this idea, i wiil ask for help later.

Future programming master.

Back to top

Profile PM Website

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 14th Oct 2007 23:05

Link

@Tone
You could just make the operator (*,/,+,-) dice yourself and that would be within the specs.

Back to top

Profile PM Email

luke810

19

Years of Service

User Offline

Joined: 4th Sep 2006

Location: United States

Posted: 14th Oct 2007 23:23

Link

Quote: "the two on the end are numbers"

Then use TDK's function for the two numbered dice and another function for the third die.

Back to top

Profile PM

TDK

Retired Moderator

23

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 14th Oct 2007 23:24 Edited at: 15th Oct 2007 00:12

Link

Quote: "Are we allowed to change up the function abit."

Strictly speaking the idea is to create something from the supplied function so you shouldn't change it. However, if you want to change the dice graphics to something else then I suppose that's OK - as long as everyone else agrees.

Writing your own 'dice' function wouldn't be allowed because the challenge is to use the one I supplied.

Actually, I was expecting a rash of Yahtzee or Poker Dice type games. A pretty screensaver is acceptable too...

Quote: "fist the opponent"

Ooh.. I don't like the sound of that!

TDK_Man

* TDK's Game Programming Forums - Open To All - DB & Team Request Boards *

Back to top

Profile PM Email Website

demons breath

22

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 14th Oct 2007 23:58

Link

OBese is right though... just leave the function as it is, use it for 2 dice, and then using your own function make a dice for the middle...

http://jamesmason01.googlepages.com/index.htm

Back to top

Profile PM Website

TDK

Retired Moderator

23

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 15th Oct 2007 00:14 Edited at: 15th Oct 2007 00:18

Link

Quote: "using your own function make a dice for the middle..."

Oh right I see - use another function as well... Yes - that's perfectly OK!

Actually, just copy the function I supplied and modify the texture making routines. (I don't know if you've looked at the function closely, but it's not a normal DB cube (you can't texture all six sides of a DB primitive with different textures).

TDK_Man

* TDK's Game Programming Forums - Open To All - DB & Team Request Boards *

Back to top

Profile PM Email Website

Tone3e

19

Years of Service

User Offline

Joined: 17th Feb 2007

Location: here

Posted: 18th Oct 2007 01:01

Link

Quote: " [quote]"fist the opponent""

Ooh.. I don't like the sound of that![/quote]
haha, i hadnt noticed that.Yeah, i am going to use another function as well. I tried to start already, but i am not having much succes. i will post back when i get something working if indeed i do.

Future programming master.

Back to top

Profile PM Website

Sinani201

19

Years of Service

User Offline

Joined: 16th Apr 2007

Location: Aperture Science Enrichment Center

Posted: 20th Oct 2007 02:15

Link

Sorry guys I haven't been online, my internet was down for a strange reason (lol I did like 10 virus checks), but now I have it back!! To bad in that whole period I forgot to copy the dice function in my projects folder.

how do you make a sig?

Back to top

Profile PM

Tone3e

19

Years of Service

User Offline

Joined: 17th Feb 2007

Location: here

Posted: 23rd Oct 2007 00:52

Link

Here is the start of my entry, but i am having some trouble with some things.

Rem DBC Programming Challenges
Rem Dice Challenge
Rem By:Ton3e

Gosub Setup

Do
  Rem Main Program Loop
  Gosub firstDice
  Gosub secondDice
  Gosub thirdDice
  Sync
Loop
End

Rem ****************************************************************************************************
Rem ***                                        Procedures                                            ***
Rem ****************************************************************************************************

Setup:
  Set Display Mode 800,600,32
  AutoCam Off
  Sync On
  Sync Rate 0
  CLS 0
  Randomize Timer()
  ink rgb(255,255,255),0
  Set Cursor 360,200
  Print "You Have To Beat"
  Num2beat=rnd(36)
  set cursor 400,300
  print Num2beat
  wait 3000
  Dim DScore(6)
  PLACE=1
  Rem ********************************************************************************
  MakeDice(2,1,3.0)
  Position Object 1,-7,0,0
  Position Object 2,7,0,0
  Position Camera 0,0,-15
  MakeOtherDice(1,3,3.0)
  Position object 3,0,0,0
Return

firstDice:
       IF PLACE=1
         R = Rnd(3)*10
         XRotate Object 1,WrapValue(Object Angle X(1)+R)
         YRotate Object 1,WrapValue(Object Angle Y(1)+R)
         If spacekey()=1 AND PLACE=1
          DScore(N)=Rnd(5)+1: Rem Random dice face chosen
          Select DScore(N)
           Case 1: Rotate Object 1,0,90,0: EndCase
           Case 2: Rotate Object 1,0,180,0: EndCase
           Case 3: Rotate Object 1,90,0,0: EndCase
           Case 4: Rotate Object 1,270,0,0: EndCase
           Case 5: Rotate Object 1,0,0,0: EndCase
           Case 6: Rotate Object 1,0,270,0: EndCase
          EndSelect
          INC PLACE
          WAIT 1000
          Return
         Endif
       ENDIF
  RETURN

secondDice:
      IF PLACE=2
         R = Rnd(3)*10
         XRotate Object 2,WrapValue(Object Angle X(1)+R)
         YRotate Object 2,WrapValue(Object Angle Y(1)+R)
         If spacekey()=1 AND PLACE=2
          DScore(N)=Rnd(5)+1: Rem Random dice face chosen
          Select DScore(N)
           Case 1: Rotate Object 2,0,90,0: EndCase
           Case 2: Rotate Object 2,0,180,0: EndCase
           Case 3: Rotate Object 2,90,0,0: EndCase
           Case 4: Rotate Object 2,270,0,0: EndCase
           Case 5: Rotate Object 2,0,0,0: EndCase
           Case 6: Rotate Object 2,0,270,0: EndCase
          EndSelect
          INC PLACE
          WAIT 1000
          Return
         Endif
      ENDIF
   RETURN

thirdDice:
      IF PLACE=3
         R = Rnd(3)*10
         XRotate Object 3,WrapValue(Object Angle X(1)+R)
         YRotate Object 3,WrapValue(Object Angle Y(1)+R)
         If spacekey()=1 AND PLACE=3
          DScore(N)=Rnd(5)+1: Rem Random dice face chosen
          Select DScore(N)
           Case 1: Rotate Object 3,0,90,0: EndCase
           Case 2: Rotate Object 3,0,180,0: EndCase
           Case 3: Rotate Object 3,90,0,0: EndCase
           Case 4: Rotate Object 3,270,0,0: EndCase
           Case 5: Rotate Object 3,0,0,0: EndCase
           Case 6: Rotate Object 3,0,270,0: EndCase
          EndSelect
          END
         Endif
      ENDIF
    RETURN

Rem ****************************************************************************************************
Rem ***                                        Functions                                             ***
Rem ****************************************************************************************************

Function MakeDice(NumDice,StartObjNumber,DiceSize#)
  Create Bitmap 1,800,600
  CLS RGB(85,0,0)
  Rem Number One
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 128,128,N: Circle 128,129,N
  Next N
  Get Image 1001,0,0,256,256
  Rem Number Two
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1002,0,0,256,256
  Rem Number Three
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1003,0,0,256,256
  Rem Number Four
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1004,0,0,256,256
  Rem Number Five
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1005,0,0,256,256
  Rem Number Six
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,128,N: Circle 46,129,N
    Circle 208,128,N: Circle 208,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1006,0,0,256,256
  Set Current Bitmap 0
  Delete Bitmap 1
  For ObjNum = StartObjNumber To StartObjNumber+(NumDice-1)
    Offset#=DiceSize#/2.0: MeshNum=2000: PlainNum=2000
    Make Object Cube ObjNum,DiceSize#
    Make Object Plain PlainNum,DiceSize#,DiceSize#
    Make Mesh From Object MeshNum,PlainNum
    ADD LIMB ObjNum,1,2000: Offset Limb ObjNum,1,0,0,0.0-Offset#: Rem Cube Side 1 (Front)
    ADD LIMB ObjNum,2,2000: Rotate Limb ObjNum,2,0,90,0: Offset Limb ObjNum,2,0.0-Offset#,0,0: Rem Cube Side 2 (Left)
    ADD LIMB ObjNum,3,2000: Rotate Limb ObjNum,3,0,180,0: Offset Limb ObjNum,3,0,0,Offset#:  Rem Cube Side 3 (Back)
    ADD LIMB ObjNum,4,2000: Rotate Limb ObjNum,4,0,270,0: Offset Limb ObjNum,4,Offset#,0,0:  Rem Cube Side 4 (Right)
    ADD LIMB ObjNum,5,2000: Rotate Limb ObjNum,5,270,0,0: Offset Limb ObjNum,5,0,0.0-Offset#,0: Rem Cube Side 5 (Bottom)
    ADD LIMB ObjNum,6,2000: Rotate Limb ObjNum,6,90,0,0: Offset Limb ObjNum,6,0,Offset#,0: Rem Cube Side 6 (Top)
    Delete Mesh MeshNum
    Delete Object PlainNum
    Hide Limb ObjNum,0
    Texture LIMB ObjNum,1,1005: Texture LIMB ObjNum,2,1006
    Texture LIMB ObjNum,3,1002: Texture LIMB ObjNum,4,1001
    Texture LIMB ObjNum,5,1003: Texture LIMB ObjNum,6,1004
  Next ObjNum
EndFunction

Function MakeOtherDice(NumDice,StartObjNumber,DiceSize#)
  Create Bitmap 1,800,600
  CLS RGB(85,0,0)
  Rem subtract
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N
  Next N
  Get Image 2001,0,0,256,256
  Rem add
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N:box 110,35,110+N,195+N
  Next N
  Get Image 2002,0,0,256,256
  Rem multiply
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    line 20+N,20,210+N,234:line 210+N,20,20+N,234
  Next N
  Get Image 2003,0,0,256,256
  Rem divide
 Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N
    Circle 128,70,N: Circle 128,71,N
    Circle 128,180,N: Circle 128,181,N
    Next N
  Get Image 2004,0,0,256,256
  Rem subtract
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N
  Next N
  Get Image 2005,0,0,256,256
  Rem add
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N:box 110,35,110+N,195+N
  Next N
  Get Image 2006,0,0,256,256
  Set Current Bitmap 0
  Delete Bitmap 1
  For ObjNum = StartObjNumber To StartObjNumber+(NumDice-1)
    Offset#=DiceSize#/2.0: MeshNum=2000: PlainNum=2000
    Make Object Cube ObjNum,DiceSize#
    Make Object Plain PlainNum,DiceSize#,DiceSize#
    Make Mesh From Object MeshNum,PlainNum
    ADD LIMB ObjNum,1,2000: Offset Limb ObjNum,1,0,0,0.0-Offset#: Rem Cube Side 1 (Front)
    ADD LIMB ObjNum,2,2000: Rotate Limb ObjNum,2,0,90,0: Offset Limb ObjNum,2,0.0-Offset#,0,0: Rem Cube Side 2 (Left)
    ADD LIMB ObjNum,3,2000: Rotate Limb ObjNum,3,0,180,0: Offset Limb ObjNum,3,0,0,Offset#:  Rem Cube Side 3 (Back)
    ADD LIMB ObjNum,4,2000: Rotate Limb ObjNum,4,0,270,0: Offset Limb ObjNum,4,Offset#,0,0:  Rem Cube Side 4 (Right)
    ADD LIMB ObjNum,5,2000: Rotate Limb ObjNum,5,270,0,0: Offset Limb ObjNum,5,0,0.0-Offset#,0: Rem Cube Side 5 (Bottom)
    ADD LIMB ObjNum,6,2000: Rotate Limb ObjNum,6,90,0,0: Offset Limb ObjNum,6,0,Offset#,0: Rem Cube Side 6 (Top)
    Delete Mesh MeshNum
    Delete Object PlainNum
    Hide Limb ObjNum,0
    Texture LIMB ObjNum,1,2005: Texture LIMB ObjNum,2,2006
    Texture LIMB ObjNum,3,2002: Texture LIMB ObjNum,4,2001
    Texture LIMB ObjNum,5,2003: Texture LIMB ObjNum,6,2004
  Next ObjNum
EndFunction

+ Code Snippet

Rem DBC Programming Challenges
Rem Dice Challenge
Rem By:Ton3e

Gosub Setup

Do
  Rem Main Program Loop
  Gosub firstDice
  Gosub secondDice
  Gosub thirdDice
  Sync
Loop
End

Rem ****************************************************************************************************
Rem ***                                        Procedures                                            ***
Rem ****************************************************************************************************

Setup:
  Set Display Mode 800,600,32
  AutoCam Off
  Sync On
  Sync Rate 0
  CLS 0
  Randomize Timer()
  ink rgb(255,255,255),0
  Set Cursor 360,200
  Print "You Have To Beat"
  Num2beat=rnd(36)
  set cursor 400,300
  print Num2beat
  wait 3000
  Dim DScore(6)
  PLACE=1
  Rem ********************************************************************************
  MakeDice(2,1,3.0)
  Position Object 1,-7,0,0
  Position Object 2,7,0,0
  Position Camera 0,0,-15
  MakeOtherDice(1,3,3.0)
  Position object 3,0,0,0
Return

  firstDice:
       IF PLACE=1
         R = Rnd(3)*10
         XRotate Object 1,WrapValue(Object Angle X(1)+R)
         YRotate Object 1,WrapValue(Object Angle Y(1)+R)
         If spacekey()=1 AND PLACE=1
          DScore(N)=Rnd(5)+1: Rem Random dice face chosen
          Select DScore(N)
           Case 1: Rotate Object 1,0,90,0: EndCase
           Case 2: Rotate Object 1,0,180,0: EndCase
           Case 3: Rotate Object 1,90,0,0: EndCase
           Case 4: Rotate Object 1,270,0,0: EndCase
           Case 5: Rotate Object 1,0,0,0: EndCase
           Case 6: Rotate Object 1,0,270,0: EndCase
          EndSelect
          INC PLACE
          WAIT 1000
          Return
         Endif
       ENDIF
  RETURN


   secondDice:
      IF PLACE=2
         R = Rnd(3)*10
         XRotate Object 2,WrapValue(Object Angle X(1)+R)
         YRotate Object 2,WrapValue(Object Angle Y(1)+R)
         If spacekey()=1 AND PLACE=2
          DScore(N)=Rnd(5)+1: Rem Random dice face chosen
          Select DScore(N)
           Case 1: Rotate Object 2,0,90,0: EndCase
           Case 2: Rotate Object 2,0,180,0: EndCase
           Case 3: Rotate Object 2,90,0,0: EndCase
           Case 4: Rotate Object 2,270,0,0: EndCase
           Case 5: Rotate Object 2,0,0,0: EndCase
           Case 6: Rotate Object 2,0,270,0: EndCase
          EndSelect
          INC PLACE
          WAIT 1000
          Return
         Endif
      ENDIF
   RETURN


    thirdDice:
      IF PLACE=3
         R = Rnd(3)*10
         XRotate Object 3,WrapValue(Object Angle X(1)+R)
         YRotate Object 3,WrapValue(Object Angle Y(1)+R)
         If spacekey()=1 AND PLACE=3
          DScore(N)=Rnd(5)+1: Rem Random dice face chosen
          Select DScore(N)
           Case 1: Rotate Object 3,0,90,0: EndCase
           Case 2: Rotate Object 3,0,180,0: EndCase
           Case 3: Rotate Object 3,90,0,0: EndCase
           Case 4: Rotate Object 3,270,0,0: EndCase
           Case 5: Rotate Object 3,0,0,0: EndCase
           Case 6: Rotate Object 3,0,270,0: EndCase
          EndSelect
          END
         Endif
      ENDIF
    RETURN


Rem ****************************************************************************************************
Rem ***                                        Functions                                             ***
Rem ****************************************************************************************************

Function MakeDice(NumDice,StartObjNumber,DiceSize#)
  Create Bitmap 1,800,600
  CLS RGB(85,0,0)
  Rem Number One
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 128,128,N: Circle 128,129,N
  Next N
  Get Image 1001,0,0,256,256
  Rem Number Two
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1002,0,0,256,256
  Rem Number Three
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1003,0,0,256,256
  Rem Number Four
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1004,0,0,256,256
  Rem Number Five
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 128,128,N: Circle 128,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1005,0,0,256,256
  Rem Number Six
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    Circle 46,46,N: Circle 46,47,N
    Circle 208,46,N: Circle 208,47,N
    Circle 46,128,N: Circle 46,129,N
    Circle 208,128,N: Circle 208,129,N
    Circle 46,208,N: Circle 46,209,N
    Circle 208,208,N: Circle 208,209,N
  Next N
  Get Image 1006,0,0,256,256
  Set Current Bitmap 0
  Delete Bitmap 1
  For ObjNum = StartObjNumber To StartObjNumber+(NumDice-1)
    Offset#=DiceSize#/2.0: MeshNum=2000: PlainNum=2000
    Make Object Cube ObjNum,DiceSize#
    Make Object Plain PlainNum,DiceSize#,DiceSize#
    Make Mesh From Object MeshNum,PlainNum
    ADD LIMB ObjNum,1,2000: Offset Limb ObjNum,1,0,0,0.0-Offset#: Rem Cube Side 1 (Front)
    ADD LIMB ObjNum,2,2000: Rotate Limb ObjNum,2,0,90,0: Offset Limb ObjNum,2,0.0-Offset#,0,0: Rem Cube Side 2 (Left)
    ADD LIMB ObjNum,3,2000: Rotate Limb ObjNum,3,0,180,0: Offset Limb ObjNum,3,0,0,Offset#:  Rem Cube Side 3 (Back)
    ADD LIMB ObjNum,4,2000: Rotate Limb ObjNum,4,0,270,0: Offset Limb ObjNum,4,Offset#,0,0:  Rem Cube Side 4 (Right)
    ADD LIMB ObjNum,5,2000: Rotate Limb ObjNum,5,270,0,0: Offset Limb ObjNum,5,0,0.0-Offset#,0: Rem Cube Side 5 (Bottom)
    ADD LIMB ObjNum,6,2000: Rotate Limb ObjNum,6,90,0,0: Offset Limb ObjNum,6,0,Offset#,0: Rem Cube Side 6 (Top)
    Delete Mesh MeshNum
    Delete Object PlainNum
    Hide Limb ObjNum,0
    Texture LIMB ObjNum,1,1005: Texture LIMB ObjNum,2,1006
    Texture LIMB ObjNum,3,1002: Texture LIMB ObjNum,4,1001
    Texture LIMB ObjNum,5,1003: Texture LIMB ObjNum,6,1004
  Next ObjNum
EndFunction

Function MakeOtherDice(NumDice,StartObjNumber,DiceSize#)
  Create Bitmap 1,800,600
  CLS RGB(85,0,0)
  Rem subtract
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N
  Next N
  Get Image 2001,0,0,256,256
  Rem add
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N:box 110,35,110+N,195+N
  Next N
  Get Image 2002,0,0,256,256
  Rem multiply
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    line 20+N,20,210+N,234:line 210+N,20,20+N,234
  Next N
  Get Image 2003,0,0,256,256
  Rem divide
 Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N
    Circle 128,70,N: Circle 128,71,N
    Circle 128,180,N: Circle 128,181,N
    Next N
  Get Image 2004,0,0,256,256
  Rem subtract
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N
  Next N
  Get Image 2005,0,0,256,256
  Rem add
  Ink RGB(255,0,0),0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  For N=1 To 24
    box 35,110,195+N,110+N:box 110,35,110+N,195+N
  Next N
  Get Image 2006,0,0,256,256
  Set Current Bitmap 0
  Delete Bitmap 1
  For ObjNum = StartObjNumber To StartObjNumber+(NumDice-1)
    Offset#=DiceSize#/2.0: MeshNum=2000: PlainNum=2000
    Make Object Cube ObjNum,DiceSize#
    Make Object Plain PlainNum,DiceSize#,DiceSize#
    Make Mesh From Object MeshNum,PlainNum
    ADD LIMB ObjNum,1,2000: Offset Limb ObjNum,1,0,0,0.0-Offset#: Rem Cube Side 1 (Front)
    ADD LIMB ObjNum,2,2000: Rotate Limb ObjNum,2,0,90,0: Offset Limb ObjNum,2,0.0-Offset#,0,0: Rem Cube Side 2 (Left)
    ADD LIMB ObjNum,3,2000: Rotate Limb ObjNum,3,0,180,0: Offset Limb ObjNum,3,0,0,Offset#:  Rem Cube Side 3 (Back)
    ADD LIMB ObjNum,4,2000: Rotate Limb ObjNum,4,0,270,0: Offset Limb ObjNum,4,Offset#,0,0:  Rem Cube Side 4 (Right)
    ADD LIMB ObjNum,5,2000: Rotate Limb ObjNum,5,270,0,0: Offset Limb ObjNum,5,0,0.0-Offset#,0: Rem Cube Side 5 (Bottom)
    ADD LIMB ObjNum,6,2000: Rotate Limb ObjNum,6,90,0,0: Offset Limb ObjNum,6,0,Offset#,0: Rem Cube Side 6 (Top)
    Delete Mesh MeshNum
    Delete Object PlainNum
    Hide Limb ObjNum,0
    Texture LIMB ObjNum,1,2005: Texture LIMB ObjNum,2,2006
    Texture LIMB ObjNum,3,2002: Texture LIMB ObjNum,4,2001
    Texture LIMB ObjNum,5,2003: Texture LIMB ObjNum,6,2004
  Next ObjNum
EndFunction

1.The second and third die dont totate too well.
2.How do i store the number on the face of each dice so i can do the math and compare it to the num2beat variable.

If anyone could help me i would appreciate it, and if not then i will try my best to finish it. This is barely the second challenge i enter, even though i have been following them since the beggining, but i didnt enter my other entries because they were just really bad. Hopefully this one is all right.

Future programming master.

Back to top

Profile PM Website

LBFN

19

Years of Service

User Offline

Joined: 7th Apr 2007

Location: USA

Posted: 23rd Oct 2007 06:53

Link

Quote: "Challenge closes: 20th October at midnight GMT (Saturday Night).
"

???? I was looking for the winner, but didn't see one or an extension/change to the challenge. Did I miss something?

LB

Back to top

Profile PM Email

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 23rd Oct 2007 12:35

Link

I expect TDK's been called off to something. Who does that mean needs to decide the winner/s? Although as far as I can see I'm the only one who's entered...

the rabi, Nancy DrewG and Sudoku Arts.

Back to top

Profile PM

demons breath

22

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 23rd Oct 2007 12:46

Link

Yeah what happened? This just sort of died...

http://jamesmason01.googlepages.com/index.htm

Back to top

Profile PM Website

TDK

Retired Moderator

23

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 23rd Oct 2007 23:11

Link

Sorry - major power and internet problems here in Tenerife this week.

Only just been able to get on properly for days.

Anyway, INH had the only entry as I can see, so his cup and two dice win - even though he didn't change my reading the dice from the front - I doubt they'd let you read the dice that way in Vegas!

Anyway as no-one else bothered attempting the challenge (shame on all of you), it's over to INH to set the next challenge.

TDK_Man

* TDK's Game Programming Forums - Open To All - DB & Team Request Boards *

Back to top

Profile PM Email Website

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 23rd Oct 2007 23:12

Link

Uh... uh.... uh....
I'll get back to you on that...
Help...

the rabi, Nancy DrewG and Sudoku Arts.

Back to top

Profile PM

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 23rd Oct 2007 23:17

Link

Ok (I've been noobslaped so I can't edit my post, sorry)

Write a drawing program - but not a program that lets the user draw, a program that shows a image draw by only DB's drawing or 3D commands!
The most high quality drawing is the winner... but, Bonus points for
*The program drawing (in a realistic way) the image in real-time
*The drawing being 3D (I don't know how you'd implement this, but let's see your creative side, perhaps a better name would be 'scene program')
*The drawing being 'realistic'.

This isn't really a test of basics coding abilitys, more of patients and skillz with images.

Good luck guys.

the rabi, Nancy DrewG and Sudoku Arts.

Back to top

Profile PM

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 24th Oct 2007 03:09

Link

Sorry TDK

I really couldn't think of anything original to do with that die.
Have the rules changed since DBC v1.2 is now released?

@INH
Do you mean a program that uses an image to draw from?
The user would have to be able to draw the image first, as you can't load files.

Back to top

Profile PM Email

Tone3e

19

Years of Service

User Offline

Joined: 17th Feb 2007

Location: here

Posted: 24th Oct 2007 04:22

Link

So mine wasnt considered an entry? Oh well it wasnt finished anyways and INH's was better as well. I know it was after the deadline but the judge hadnt said anything and as TDK previously pointed out that contestants could make use of that time. I dont really understand the new challenge. does it mean do make a drawing using DB's basic 2d commands?

Future programming master.

Back to top

Profile PM Website

LBFN

19

Years of Service

User Offline

Joined: 7th Apr 2007

Location: USA

Posted: 24th Oct 2007 05:23

Link

INH

Have you thought about a deadline for this? Didn't see one in the challenge post.

LB

Back to top

Profile PM Email

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 24th Oct 2007 11:27

Link

Ooops...
Saturday the 3rd of November, midnight GMT.
@OBese87
The idea is basically that you (As in the programmer) draws a picture using DB's native drawing commands.

the rabi, Nancy DrewG and Sudoku Arts.

Back to top

Profile PM

demons breath

22

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 24th Oct 2007 13:42

Link

hmmm. I'm graphically r3tarded. I might give it a go though. Haven't really been on DarkBASIC in a few days, just been spending my entire life on the forums instead

And I didn't enter for much the same reason as OBese.

http://jamesmason01.googlepages.com/index.htm

Back to top

Profile PM Website

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 24th Oct 2007 15:05

Link

Quote: "I'm graphically r3tarded"

Don't say that!

Quote: "Haven't really been on DarkBASIC in a few days, just been spending my entire life on the forums instead"

Same here...

the rabi, Nancy DrewG and Sudoku Arts.

Back to top

Profile PM

Latch

19

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 27th Oct 2007 02:36 Edited at: 27th Oct 2007 03:37

Link

@Tone3e

Quote: "So mine wasnt considered an entry?"

It was probably the timing - even though it hadn't been judged yet, I think your entry might have been a little late.

+ Code Snippet

rem parabola tunnel
rem by latch
rem 10/26/07

sync on
sync rate 60

a#=10
h=100 : k#=200
for shiftx=0 to screen width() step 4
      dec k#,.5

      for x=0 to 200
         y#=((1.0/(4.0*a#))*((x-h)^2))+k#
         ink rgb(x,x,x),0
         dot x+shiftx,y#
      next x

next shiftx
sync

wait key

Enjoy your day.

Back to top

Profile PM

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 27th Oct 2007 12:06

Link

Is that your entry latch? Very clever, especially for such small code. 3D from dots. Mmmm.

Your signature has been erased by a mod

Back to top

Profile PM

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 27th Oct 2007 20:23 Edited at: 27th Oct 2007 20:24

Link

Nice work Latch!

I've just finished this sand simulation today and well, it sort of draws (after you've set things up anyway). So I'll enter it

Entry: Sand!

remstart
~~~~~~~~~~~~~~~~~~~~~~~~~
   Sand Simulation
~~~~~~~~~~~~~~~~~~~~~~~~~
There are 4 different cell types:
* Empty Cells
* Tap Cells
   Taps produce sand cells in the square below (if empty)
* Sand Cells
   Sand falls to the square below, if it comes into contact with a foreign
   cell type it will remain there, if it collides with another sand cell it will try to
   move off diagonally down to one side (right has priority), if neither side is open it will stay where it is
* Wall Cells
   Wall cells stop sand from spilling out
~~~~~~~~~~~~~~~~~~~~~~~~~
remend

`Setup
sync on

`Define Active Screen Position
sx=100 : sy=100

`Make Cell Array
DIM cell(1,49,49)
active=0
empty=0 : sand=1 : solid=2 : tap=3

`colours
DIM colour(3)
colour(0)=rgb(40,40,40)
colour(1)=rgb(255,255,100)
colour(2)=rgb(128,0,128)
colour(3)=rgb(255,0,0)

`square scale
scale=5

`~~~~~~~~~~~~~~~~~~~~
` EDITOR
`~~~~~~~~~~~~~~~~~~~~
`blank
ink colour(empty),0
box sx,sy,sx+(49*scale),sy+(49*scale)

`make solid frame
ink colour(solid),0
for a = 0 to 1
   for s = 0 to 49
      cell(a,s,49)=solid
      cell(a,0,s)=solid
      cell(a,49,s)=solid
      box sx+(s*scale),sy+(49*scale),sx+(s*scale)+scale,sy+(49*scale)+scale
      box sx+(0*scale),sy+(s*scale),sx+(0*scale)+scale,sy+(s*scale)+scale
      box sx+(49*scale),sy+(s*scale),sx+(49*scale)+scale,sy+(s*scale)+scale
   next s
next a

DO
   mx=(mousex()-sx)/scale : my=(mousey()-sy)/scale : mc=mouseclick()

if mc>0 and mc<3
      if mx>=0 and mx<50
         if my>=0 and my<50
            cell(0,mx,my)=mc+1
            if mc=1 then cell(1,mx,my)=mc+1
            `draw cell
            ink colour( cell(0,mx,my) ),0
            box sx+(mx*scale),sy+(my*scale),sx+(mx*scale)+scale,sy+(my*scale)+scale
         endif
      endif
   endif

if returnkey()=1 then exit

text 0,0,"Left Click to place solid cells, Right click to place a sand tap."
   text 0,20,"PRESS RETURN TO BEGIN SIMULATION"

sync
LOOP

`~~~~~~~~~~~~~~~~~~~~
` Main Loop
`~~~~~~~~~~~~~~~~~~~~
hide mouse
do
   for y = 0 to 49
      for x = 0 to 49
         `Tap
         if cell(active,x,y)=tap
            if y<49
               if cell(active,x,y+1)=empty then cell(active,x,y+1)=sand
            endif
         endif

`Sand
         if cell(active,x,y)=sand
            if y<49
               `drop sand
               if cell(active,x,y+1)=empty
                  cell(1-active,x,y)=empty : cell(1-active,x,y+1)=sand
               else
                  if x<49
                     if cell(active,x+1,y+1)=empty
                        cell(1-active,x,y)=empty : cell(1-active,x+1,y+1)=sand
                     else
                        if x>0
                           if cell(active,x-1,y+1)=empty
                              cell(1-active,x,y)=empty : cell(1-active,x-1,y+1)=sand
                           else
                              cell(1-active,x,y)=sand
                           endif
                       endif
                     endif
                  endif
               endif
            endif
         endif

`*DISPLAY
         ink colour( cell(active,x,y) ),0
         box sx+(x*scale),sy+(y*scale),sx+(x*scale)+scale,sy+(y*scale)+scale
      next x
   next y

active=1-active

sync
loop

+ Code Snippet

remstart
~~~~~~~~~~~~~~~~~~~~~~~~~
   Sand Simulation
~~~~~~~~~~~~~~~~~~~~~~~~~
There are 4 different cell types:
* Empty Cells
* Tap Cells
   Taps produce sand cells in the square below (if empty)
* Sand Cells
   Sand falls to the square below, if it comes into contact with a foreign
   cell type it will remain there, if it collides with another sand cell it will try to
   move off diagonally down to one side (right has priority), if neither side is open it will stay where it is
* Wall Cells
   Wall cells stop sand from spilling out
~~~~~~~~~~~~~~~~~~~~~~~~~
remend

`Setup
sync on

`Define Active Screen Position
sx=100 : sy=100

`Make Cell Array
DIM cell(1,49,49)
active=0
empty=0 : sand=1 : solid=2 : tap=3

`colours
DIM colour(3)
colour(0)=rgb(40,40,40)
colour(1)=rgb(255,255,100)
colour(2)=rgb(128,0,128)
colour(3)=rgb(255,0,0)

`square scale
scale=5

`~~~~~~~~~~~~~~~~~~~~
` EDITOR
`~~~~~~~~~~~~~~~~~~~~
`blank
ink colour(empty),0
box sx,sy,sx+(49*scale),sy+(49*scale)

`make solid frame
ink colour(solid),0
for a = 0 to 1
   for s = 0 to 49
      cell(a,s,49)=solid
      cell(a,0,s)=solid
      cell(a,49,s)=solid
      box sx+(s*scale),sy+(49*scale),sx+(s*scale)+scale,sy+(49*scale)+scale
      box sx+(0*scale),sy+(s*scale),sx+(0*scale)+scale,sy+(s*scale)+scale
      box sx+(49*scale),sy+(s*scale),sx+(49*scale)+scale,sy+(s*scale)+scale
   next s
next a

DO
   mx=(mousex()-sx)/scale : my=(mousey()-sy)/scale : mc=mouseclick()

   if mc>0 and mc<3
      if mx>=0 and mx<50
         if my>=0 and my<50
            cell(0,mx,my)=mc+1
            if mc=1 then cell(1,mx,my)=mc+1
            `draw cell
            ink colour( cell(0,mx,my) ),0
            box sx+(mx*scale),sy+(my*scale),sx+(mx*scale)+scale,sy+(my*scale)+scale
         endif
      endif
   endif

   if returnkey()=1 then exit

   text 0,0,"Left Click to place solid cells, Right click to place a sand tap."
   text 0,20,"PRESS RETURN TO BEGIN SIMULATION"

   sync
LOOP

`~~~~~~~~~~~~~~~~~~~~
` Main Loop
`~~~~~~~~~~~~~~~~~~~~
hide mouse
do
   for y = 0 to 49
      for x = 0 to 49
         `Tap
         if cell(active,x,y)=tap
            if y<49
               if cell(active,x,y+1)=empty then cell(active,x,y+1)=sand
            endif
         endif

         `Sand
         if cell(active,x,y)=sand
            if y<49
               `drop sand
               if cell(active,x,y+1)=empty
                  cell(1-active,x,y)=empty : cell(1-active,x,y+1)=sand
               else
                  if x<49
                     if cell(active,x+1,y+1)=empty
                        cell(1-active,x,y)=empty : cell(1-active,x+1,y+1)=sand
                     else
                        if x>0
                           if cell(active,x-1,y+1)=empty
                              cell(1-active,x,y)=empty : cell(1-active,x-1,y+1)=sand
                           else
                              cell(1-active,x,y)=sand
                           endif
                       endif
                     endif
                  endif
               endif
            endif
         endif

         `*DISPLAY
         ink colour( cell(active,x,y) ),0
         box sx+(x*scale),sy+(y*scale),sx+(x*scale)+scale,sy+(y*scale)+scale
      next x
   next y

   active=1-active

   sync
loop

I've just realised I never use CLS in this code! Is that a problem?

Back to top

Profile PM Email

Latch

19

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 27th Oct 2007 21:30

Link

@OB

Quote: "Nice work Latch!"

Thank you.

That sand pouring is really great!

I wonder if there is a way to store the order of which cells "turn on" so you don't have to test the conditionals every time through the draw loop. The setup would be before the actual drawing. Maybe this order would be stored in an array, and then in a game, you only have to loop through the array so it would be faster than testing the conditionals.

@INH
Yup, that's an entry.

Quote: "Very clever, especially for such small code"

Thank you.

Here's an updated version - I just changed the color a bit so the "inside" of the tunnel is more visible:

+ Code Snippet

rem parabola tunnel
rem by latch
rem 10/26/07

sync on
sync rate 60

a#=10
h=100 : k#=200
for shiftx=0 to screen width() step 4
      dec k#,.5

      for x=0 to 200
         y#=((1.0/(4.0*a#))*((x-h)^2))+k#
         ink rgb(x+55,x+55,x+55),0
         dot x+shiftx,y#
      next x

next shiftx
sync

wait key

And here's some goofball eyes that follow the mouse pointer:

+ Code Snippet

rem face
rem by latch

sync on
sync rate 60

ink rgb(255,255,255),0

x1=100
y1=100
x2=300
y2=100
radx1=50
rady1=75
radx2=50
rady2=75

ellipse 100,100,50,75
ellipse 300,100,50,75

do
   cls
   circle 100,100,100
   circle 300,100,100
   line 75,300,325,300

   if mousex() < x1
      dec x1,10
   endif
   if mousex() > x1
      inc x1,10
   endif
   if x1-radx1 < 0 then x1=radx1
   if x1+radx1 > 200 then x1=200-radx1

   if mousex() < x2
      dec x2,10
   endif
   if mousex() > x2
      inc x2,10
   endif
   if x2 < 300-radx2 then x2=300-radx2
   if x2 > 300+radx2 then x2=300+radx2

   if mousey() < y1
      dec y1,10
   endif
   if mousey() > y1
      inc y1,10
   endif
   if y1-rady1 < 0 then y1=rady1
   if y1+rady1 > 200 then y1=200-rady1

   if mousey() < y2
      dec y2,10
   endif
   if mousey() > y2
      inc y2,10
   endif
   if y2-rady2 < 0 then y2=rady1
   if y2+rady2 > 200 then y2=200-rady2

   ellipse x1,y1,radx1,rady1
   ellipse x2,y2,radx2,rady2

   sync
loop

Enjoy your day.

Back to top

Profile PM

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 27th Oct 2007 22:59

Link

@OBese87
That is pure genius!

Very cool.
@Latch
Yep that addition helps it along nicely.
Ah, and the good old goofy eyes.

Nya!
Well, yes but - wait, what?

Back to top

Profile PM

Tone3e

19

Years of Service

User Offline

Joined: 17th Feb 2007

Location: here

Posted: 28th Oct 2007 04:27 Edited at: 28th Oct 2007 04:29

Link

This is the start if my entry. Its a 3d perspective drawing of some buildings. I might add some details like doors and windows as well as some different sized buildings.

+ Code Snippet

`DRAWING PROGRAMMING CHALLENGE
`10/25/07
`by Tone3e
sync on
hide mouse
set display mode 800,600,16
do
`SKY
cls rgb(50,50,200)
ink rgb(255,255,0),0
FOR N=1 TO 50
   circle 400,300,1+N
next N
`back of buildings
ink rgb(100,100,100),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
ink rgb(175,175,175),0
For N=1 To 499
   line 250,100+N,400,300
Next N
for n=1 to 549
   line 600,50+n,400,300
next n
`road
ink 0,0
for n=1 to 350
   LINE 400,300,250+N,599
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
line 400,300,410+n,599:line 400,300,440+n,599
next n
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 250,100,400,300
line 250,599,400,300
line 0,100,250,100
`right building
line 600,50,400,300
line 600,599,400,300
line 600,50,600,599
line 600,50,799,50
sync
loop

It is when I am weak, when I am truly strong.

Back to top

Profile PM Website

Latch

19

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 28th Oct 2007 22:23

Link

@Tone3e

(thought I posted this but it seems to have disappeared)

Starting to look good!

Enjoy your day.

Back to top

Profile PM

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 28th Oct 2007 23:46

Link

@Tone3e
I'll have a look tomorrow, I've got a busy schedule just at the moment.

Nya!
Well, yes but - wait, what?

Back to top

Profile PM

Link102

21

Years of Service

User Offline

Joined: 1st Dec 2004

Location: On your head, weeeeee!

Posted: 29th Oct 2007 17:43

Link

my entry

+ Code Snippet

sync on:sync rate 30
randomize timer()
hide mouse
radius=10
t=1
ink rgb(0,0,0),0
do
cls rgb(255,255,255)
      for r = 0 to t
         x#=newXvalue(screen width()/2,rnd(360),rnd(radius*w))
         y#=newYvalue(screen height()/2,rnd(360),rnd(radius*w))
         circle x#,y#,radius
         circle x#-radius/4,y#-radius/4,radius/8
      next r
      blur bitmap 0,3
   sync
t=t*2
w=w+2
wait 1000
loop

first one to gues what it is gets the honor

Don't look at my sig!

Back to top

Profile PM

Insert Name Here

19

Years of Service

User Offline

Joined: 20th Mar 2007

Location: Worcester, England

Posted: 29th Oct 2007 22:30

Link

@Tone3e
Looks quite nice, I can see you're using the envelope effect.
@Link102
Bubbles! I get the honor.
Unless it's like, sperm gone wrong. Nice anyway.

Nya!
Well, yes but - wait, what?

Back to top

Profile PM

Tone3e

19

Years of Service

User Offline

Joined: 17th Feb 2007

Location: here

Posted: 29th Oct 2007 23:57

Link

I dont really know what that is but ok. And link is that supposed to be cells. I need some help. In my program, I wanted to make lines to separate the building and I also wanted to color in doors and such, but for that I need to know the y value at certain points in the lines that lead to the origin.(400,300) I had an idea and was almost sure it would work which involved making a function and implementing the slope formula and the y slpoe form to figure out that y value, but it dint work. I erased it already but it went sort of like this.

+ Code Snippet

function Yvalue(x1,y1,x2)
m=abs[(-y1+300)/(x1-400)]
y2=abs([m*(x1-x2)]-y1)
line x1,y1,x2,y2
endfunction

where x1,y1 is the initial point and y1 is the ending x value. I think that maybe the parenthesis were placed wrong or something i dont know how to make it work. If i cant figure it out then I am afraid I cant add to my entry. If anyone could help me I would appreciate it.

It is when I am weak, when I am truly strong.

Back to top

Profile PM Website

TDK

Retired Moderator

23

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 30th Oct 2007 02:30

Link

Quote: "y2=abs([m*(x1-x2)]-y1)
m=abs[(-y1+300)/(x1-400)]"

You can't use square brackets in a formula. You should use normal brackets - ( and ).

You also can't refer to a variable in negative format. Use:

m=abs(((0-y1)+300)/(x1-400))
y2=abs((m*(x1-x2))-y1)

instead...

TDK_Man

* TDK's Game Programming Forums - Open To All - DB & Team Request Boards *

Back to top

Profile PM Email Website

Tone3e

19

Years of Service

User Offline

Joined: 17th Feb 2007

Location: here

Posted: 31st Oct 2007 04:22

Link

Thanks TDK, I figured out thanks to you. Here is an updated version. I might change something like color or maybe even size, but I dont want to do too much to it since it has already taken so much of my time.

`10/25/07
`by Tone3e
sync on
hide mouse
set display mode 800,600,16
randomize timer()
`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 30
   CIRCLE 400,300,N
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

do
 `back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 350
   LINE 400,300,250+N,599
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
   line 400,300,410+n,599:line 400,300,440+n,599
next n
sync
loop
end
Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

+ Code Snippet

`10/25/07
`by Tone3e
sync on
hide mouse
set display mode 800,600,16
randomize timer()
`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 30
   CIRCLE 400,300,N
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

do
 `back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 350
   LINE 400,300,250+N,599
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
   line 400,300,410+n,599:line 400,300,440+n,599
next n
sync
loop
end
Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

It is when I am weak, when I am truly strong.

Back to top

Profile PM Website

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 31st Oct 2007 23:21

Link

@Tone3e
I've added some functions to your code that you can use to make it a little smoother, they are quite slow though so I had to remove the loop and only draw once.
I messed up the sun but I actually quite like it like that

`10/25/07
`by Tone3e
sync on
hide mouse
set display mode 800,600,16
randomize timer()
`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 300
   @dCIRCLE(400,300,n)
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

`back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 350
   @dLINE(400,300,250+N,599)
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
   line 400,300,410+n,599:line 400,300,440+n,599
next n

sync
wait key
end

Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

`DLine Function by OBese87
FUNCTION @dline(l,t,r,b)
   w = r-l : h = b-t
   if w >= 0 then xstep = 1 else xstep = -1
   if h >= 0 then ystep = 1 else ystep = -1
   w# = ABS(w) : h# = ABS(h)
   if w#=0 then w#=0.1
   if h#=0 then h#=0.1
   xfact# = w#/h#
   yfact# = h#/w#

x = 0 : y = 0
   repeat
      `don't overshoot
      if abs(x+xstep) > abs(w) then xstep = 0
      if abs(y+ystep) > abs(h) then ystep = 0

dot x+l,y+t
      if yfact# > xfact#
         inc y,ystep
         if ABS(x) < ABS(y*xfact#) then inc x,xstep
      else
         inc x,xstep
         if ABS(y) < ABS(x*yfact#) then inc y,ystep
      endif
   until xstep = 0 and ystep = 0
ENDFUNCTION

`Round up
FUNCTION @Round(n#)
   dec# = n# - int(n#)
   n = n# + dec#
ENDFUNCTION n

FUNCTION @dCircle(x,y,r)
   for dg = 0 to 359
      dot @round(x+sin(dg)*r),@round(y+cos(dg)*r)
   next dg
ENDFUNCTION

+ Code Snippet

`10/25/07
`by Tone3e
sync on
hide mouse
set display mode 800,600,16
randomize timer()
`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 300
   @dCIRCLE(400,300,n)
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

 `back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 350
   @dLINE(400,300,250+N,599)
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
   line 400,300,410+n,599:line 400,300,440+n,599
next n

sync
wait key
end

Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

`DLine Function by OBese87
FUNCTION @dline(l,t,r,b)
   w = r-l : h = b-t
   if w >= 0 then xstep = 1 else xstep = -1
   if h >= 0 then ystep = 1 else ystep = -1
   w# = ABS(w) : h# = ABS(h)
   if w#=0 then w#=0.1
   if h#=0 then h#=0.1
   xfact# = w#/h#
   yfact# = h#/w#

   x = 0 : y = 0
   repeat
      `don't overshoot
      if abs(x+xstep) > abs(w) then xstep = 0
      if abs(y+ystep) > abs(h) then ystep = 0

      dot x+l,y+t
      if yfact# > xfact#
         inc y,ystep
         if ABS(x) < ABS(y*xfact#) then inc x,xstep
      else
         inc x,xstep
         if ABS(y) < ABS(x*yfact#) then inc y,ystep
      endif
   until xstep = 0 and ystep = 0
ENDFUNCTION

`Round up
FUNCTION @Round(n#)
   dec# = n# - int(n#)
   n = n# + dec#
ENDFUNCTION n

FUNCTION @dCircle(x,y,r)
   for dg = 0 to 359
      dot @round(x+sin(dg)*r),@round(y+cos(dg)*r)
   next dg
ENDFUNCTION

can anyone tell me why you can see the cpu drawing when the sync is after all that?

I thought that's what sync was for!

"You must be someone's friend to make comments about them." - MySpace lied.

Back to top

Profile PM Email

TDK

Retired Moderator

23

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 1st Nov 2007 00:51 Edited at: 1st Nov 2007 01:05

Link

Quote: "can anyone tell me why you can see the cpu drawing when the sync is after all that?"

Sync is meant for syncronising the 3D scene - not 2D. Plus the fact that 2D is so slow. But, having looked at it a little closer, there's something odd going on...

A little trick in 2D is to use Set Gamma to 0 before starting the drawing and then turn it back on when it's finished.

[Edit] On closer inspection, there's something screwy going on with some of those functions - not sure what though... possibly some command used was forcing a Sync...

Any way, I'm not sure what the functions were actually being used for as you don't need them. I re-did it without them and you no longer see anything being drawn.

The version with only one function:

`10/25/07
`by Tone3e
set display mode 800,600,16
sync rate 0
sync on
Backdrop Off
hide mouse
randomize timer()
`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 300
  CIRCLE 400,300,n
  CIRCLE 400,301,n
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

`back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 351
   rem @dLINE(400,300,250+N,599)
   LINE 400,300,249+N,600
   LINE 400,300,249+N,601
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
  line 400,300,410+n,599:line 400,300,440+n,599
next n

sync
wait key
end

Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

+ Code Snippet

`10/25/07
`by Tone3e
set display mode 800,600,16
sync rate 0
sync on
Backdrop Off
hide mouse
randomize timer()
`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 300
  CIRCLE 400,300,n
  CIRCLE 400,301,n
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

 `back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 351
   rem @dLINE(400,300,250+N,599)
   LINE 400,300,249+N,600
   LINE 400,300,249+N,601
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
  line 400,300,410+n,599:line 400,300,440+n,599
next n

sync
wait key
end

Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

TDK_Man

* TDK's Game Programming Forums - Open To All - DB & Team Request Boards *

Back to top

Profile PM Email Website

demons breath

22

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 1st Nov 2007 01:09

Link

OH! you just have to basically create a picture

I thought you had to show the computer drawing it step by step :S

I might actually try and enter this then...

Back to top

Profile PM Website

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 1st Nov 2007 02:23

Link

@TDK
ha, that's a very sneaky way of solving the problem. looks good.
I kinda liked my accidental sun but that's up to tone3e.
those functions were my add-ins so blame me for the weirdness

Quote: "Any way, I'm not sure what the functions were actually being used for as you don't need them."

@round - rounds a float to nearest whole number.
@dline - draws a line in dots (seems to make neater lines than DBs command, but is very slow)
@dcircle - draws a circle in dots: each circle has 360 dots so larger circles will have gaps.

here's TDK's version but with my sun

`10/25/07
`by Tone3e
set display mode 800,600,16
center text 400,300,"LOADING..."
create bitmap 1,800,600

sync on : sync rate 0
hide mouse

`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 300
  @dCIRCLE(400,301,n)
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

`back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 351
   LINE 400,300,249+N,600
   LINE 400,300,249+N,601
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
  line 400,300,410+n,599:line 400,300,440+n,599
next n

copy bitmap 1,0
sync
wait key
end

Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

FUNCTION @dCircle(x,y,r)
   for dg = 0 to 359
      dot x+sin(dg)*r, y+cos(dg)*r
   next dg
ENDFUNCTION

+ Code Snippet

`10/25/07
`by Tone3e
set display mode 800,600,16
center text 400,300,"LOADING..."
create bitmap 1,800,600

sync on : sync rate 0
hide mouse

`SKY
cls rgb(50,50,200)
ink rgb(250,250,30),0
for N=1 to 300
  @dCIRCLE(400,301,n)
NEXT N
INK RGB(50,150,50),0
box 0,300,799,599

 `back of buildings
ink rgb(50,0,0),0
BOX 0,100,250,599
box 600,50,799,599
`side of buildings
`building 1
ColorBuildings(250.0,100.0,300.0,1)
ColorBuildings(250.0,100.0,300.0,0)
ColorBuildings(250.0,599.0,300.0,1)
`building 2
ColorBuildings(600.0,50.0,500.0,1)
ColorBuildings(600.0,50.0,500.0,0)
ColorBuildings(600.0,599.0,500.0,1)
`OUTLINES
ink 0,0
`left building
line 250,100,250,599
line 0,100,250,100
`right building
line 600,50,600,599
line 600,50,799,50
`road
ink 0,0
for n=1 to 351
   LINE 400,300,249+N,600
   LINE 400,300,249+N,601
NEXT N
ink rgb(250,230,0),0
for n=1 to 10
  line 400,300,410+n,599:line 400,300,440+n,599
next n

copy bitmap 1,0
sync
wait key
end

Function ColorBuildings(x1#,y1#,x2#,outcol)
   ink rgb(100,50,50),0
   m#=((0-y1#)+300)/(x1#-400)
   y2#=abs(((m#*x2#)-(m#*400))-300)
   endcolor=abs(330-y1#)
   If outcol=1
      If y1#<300
         for n=1 to endcolor
            line x1#,y1#+n,x2#,y2#+n
         next n
      else
         for n=1 to endcolor
            line x1#,y1#-n,x2#,y2#-n
         next n
      endif
   else
      ink 0,0
      line x1#,y1#,x2#,y2#
   endif
endfunction

FUNCTION @dCircle(x,y,r)
   for dg = 0 to 359
      dot x+sin(dg)*r, y+cos(dg)*r
   next dg
ENDFUNCTION

I added a second bitmap to draw to, it sped it up amazingly!

"You must be someone's friend to make comments about them." - MySpace lied.

Back to top

Profile PM Email

demons breath

22

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 1st Nov 2007 02:34

Link

does anyone know how to make a code which basically says if a point x,y is between a line of angle q degrees from point 640,0 and another line of angle r degrees then do whatever the code is?

Sorry I'm not explaining this well but I don't know how to really. I feel like a right noob now

I think it has something to do with vectors, but that's just a hunch as I don't know what vectors are and how to use them...

Back to top

Profile PM Website

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 1st Nov 2007 04:18

Link

@demon
what are you trying to do?
what is the result of all that? (sometimes easier to work back)

"You must be someone's friend to make comments about them." - MySpace lied.

Back to top

Profile PM Email

Latch

19

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 1st Nov 2007 09:02

Link

@demons breath

Maybe something like this?

+ Code Snippet

sync on
sync rate 60

ink rgb(255,255,255),0

x1=639
y1=0
x2=100
y2=300
x3=540
y3=600


sync

do
   cls
   line x1,y1,x2,y2
   line x1,y1,x3,y3

   ang1#=atanfull(y2-y1,x2-x1)
   ang2#=atanfull(y3-y1,x3-x1)
   mouseang#=atanfull(mousey()-y1,mousex()-x1)
   text 0,0,"Angle 1 "+str$(ang1#)
   text 0,20,"Angle 2 "+str$(ang2#)
   text 0,40,"Mouse Angle "+str$(mouseang#)

   if mouseang# > ang2# and mouseang# < ang1#
      text 0,60,"Mouse position ("+str$(mousex())+","+str$(mousey())+") is between angles 1 + 2"
   endif

   sync
loop

Enjoy your day.

Back to top

Profile PM

demons breath

22

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 1st Nov 2007 10:17 Edited at: 1st Nov 2007 10:18

Link

sorry I was quite tired and a little drunk. What I actually wanted to do is to only draw certain segments of a circle. Latch, can you explain how your code works? I don't want to use the code without really understanding it, you know...

Thanks for the help, and sorry for not being clearer with my query

Back to top

Profile PM Website

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 1st Nov 2007 16:39 Edited at: 1st Nov 2007 17:06

Link

like this?

+ Code Snippet

arc(100,100,50,60,190)

END

FUNCTION arc(x,y,r,sa,fa)
   for dg = sa to fa
      dot x+sin(dg)*r,y+cos(dg)*r
   next dg
ENDFUNCTION

or like this?

+ Code Snippet

`fill up circle
x=320 : y=240 : r=100

for m = 0 to 359
   min = wrapvalue(0-m) : max = wrapvalue(0+m)
   line x+sin(min)*r,y+cos(min)*r,x+sin(max)*r,y+cos(max)*r
next m

same code with TDK style trickery

+ Code Snippet

`fill up circle
x=320 : y=240 : r=100

for m = 0 to 360
   min = wrapvalue(0-m) : max = wrapvalue(0+m)
   line x+sin(min)*r,y+cos(min)*r,x+sin(max)*r,y+cos(max)*r
   line x+sin(min)*r,y+cos(min)*r-1,x+sin(max)*r,y+cos(max)*r-1
next m

"You must be someone's friend to make comments about them." - MySpace lied.

Back to top

Profile PM Email

Latch

19

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 1st Nov 2007 17:48 Edited at: 1st Nov 2007 17:51

Link

@demon

Quote: "Latch, can you explain how your code works?"

Sure. There is a starting point in the upper right hand corner (639,0). Two lines are drawn - one down and towards the left, and one a little closer to straight down.

The atanfull() function returns the angle formed connecting two points. The order of the points determines the direction of a vector and thus the angle. For each angle, I start at (639,0) and stop at either of the line ends (either x2,y2 or x3,y3) so the equation from x1,y1 to any of the other point looks like
atanfull(y2-y1,x2-x1), or atanfull(y3-y1,x3-x1)

I do the same type of calculation using the mousex() and mousey() position to get the angle the mouse pointer is relative to (639,0).

Once I have the mouse angle, I compare it to the other two angles. If it is an angle that falls in between them, then I know the point the mouse pointer is at is between those two angles/lines.

You could use this kind of approach for an auto-lockon feature in some kind of shooting game. You create an angle that is within the range of the lock on weapon and if the target falls in between the "lines" you have the weapon lock on.

Enjoy your day.

Back to top

Profile PM

demons breath

22

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 2nd Nov 2007 04:45 Edited at: 2nd Nov 2007 11:58

Link

I'm trying to understand, but I went to my first pub 11 hours ago, and I did go to see Saw IV (amazing film, I'd most heartily recoomend it) and go for a meal (although I did get margheritas so I guess that that still counts as drinking) and go to my mate's (where I still drunk) but basically apart from that film I've had 11 hours of solid drinking. Don't mix your drinks. I would've been fine if it'd just been beer, but it was beer, lager, southern comfort, tequila, margheritas, bitter, ale and all sorts of whatever else I could find til they refused to serve me any more. I'm a wee bit drunk but I kind of understand.

Thanks Latch.

@Obese I don't have a clue what your code is doing. I'm just going to dig out some vodka and watch one of the DVDs I bought today, but I might try some of this code and ruin something I've already made.

Can you do

+ Code Snippet

if (condition 1 and condition 2) or (condition 3 and condition 4) or (condition 5 and condition 6) then doScript

I'll try it now.

EDIT:

OK Thanks Latch that code worked

sync on
sync rate 0
cls

center text 320,240,"Press any key to step through the picture"
suspend for key
cls rgb(100,100,200)

`boat
ink rgb(100,20,20),rgb(100,100,200)
for y=280 to 440
   line 70+(y/4),y,570-(y/4),y
next y
box 300,100,340,280
sync
suspend for key

`sails
ink rgb(200,200,200),rgb(100,100,200)
for x=0 to 125
   for y=0 to 140
      if (x+((140-y)/1.5))<90 then dot x+345,y+100 : dot 295-x,y+100
   next y
next x
sync
suspend for key

`waves
ink rgb(0,0,100),rgb(100,100,200)
for x=0 to 639
`   for y=0 to 479
`      ym#=(20*sin(x*4))+20
`      if y>ym# then dot x,y+240
`   next y
      ym=(15*sin(x*4))+15
      line x,ym+340,x,479
next x
sync
suspend for key

x1=639
y1=0
x2=0
y2=100
x3=100
y3=200
x4=200
y4=300
x5=300
y5=400
x6=400
y6=500
x7=500
y7=600
ang1#=atanfull(y2-y1,x2-x1)
ang2#=atanfull(y3-y1,x3-x1)
ang3#=atanfull(y4-y1,x4-x1)
ang4#=atanfull(y5-y1,x5-x1)
ang5#=atanfull(y6-y1,x6-x1)
ang6#=atanfull(y7-y1,x7-x1)

`sun
ink rgb(200,200,70),rgb(100,100,200)
for x=600 to 639
   for y=0 to 39
      if SQRT((x-640)^2+(y)^2)<39
			dot x,y
      endif
   next y
next x

for x=550 to 639
   for y=0 to 89
      drawang#=atanfull(y-y1,x-x1)
      if SQRT((x-640)^2+y^2)>50 and SQRT((x-640)^2+y^2)<89
         if (drawang#>ang2# and drawang#<ang1#) then dot x,y
         if (drawang#>ang4# and drawang#<ang3#) then dot x,y
         if (drawang#>ang6# and drawang#<ang5#) then dot x,y
      endif
   next y
next x
suspend for key
end

+ Code Snippet

sync on
sync rate 0
cls

center text 320,240,"Press any key to step through the picture"
suspend for key
cls rgb(100,100,200)



`boat
ink rgb(100,20,20),rgb(100,100,200)
for y=280 to 440
   line 70+(y/4),y,570-(y/4),y
next y
box 300,100,340,280
sync
suspend for key

`sails
ink rgb(200,200,200),rgb(100,100,200)
for x=0 to 125
   for y=0 to 140
      if (x+((140-y)/1.5))<90 then dot x+345,y+100 : dot 295-x,y+100
   next y
next x
sync
suspend for key


`waves
ink rgb(0,0,100),rgb(100,100,200)
for x=0 to 639
`   for y=0 to 479
`      ym#=(20*sin(x*4))+20
`      if y>ym# then dot x,y+240
`   next y
      ym=(15*sin(x*4))+15
      line x,ym+340,x,479
next x
sync
suspend for key

x1=639
y1=0
x2=0
y2=100
x3=100
y3=200
x4=200
y4=300
x5=300
y5=400
x6=400
y6=500
x7=500
y7=600
ang1#=atanfull(y2-y1,x2-x1)
ang2#=atanfull(y3-y1,x3-x1)
ang3#=atanfull(y4-y1,x4-x1)
ang4#=atanfull(y5-y1,x5-x1)
ang5#=atanfull(y6-y1,x6-x1)
ang6#=atanfull(y7-y1,x7-x1)

`sun
ink rgb(200,200,70),rgb(100,100,200)
for x=600 to 639
   for y=0 to 39
      if SQRT((x-640)^2+(y)^2)<39
			dot x,y
      endif
   next y
next x

for x=550 to 639
   for y=0 to 89
      drawang#=atanfull(y-y1,x-x1)
      if SQRT((x-640)^2+y^2)>50 and SQRT((x-640)^2+y^2)<89
         if (drawang#>ang2# and drawang#<ang1#) then dot x,y
         if (drawang#>ang4# and drawang#<ang3#) then dot x,y
         if (drawang#>ang6# and drawang#<ang5#) then dot x,y
      endif
   next y
next x
suspend for key
end

I may update this more later, but I'm tired and drunk and it's half four on a school night :S

EDIT 2: OK revised the code a bit... I spent ages last night thinking "I wonder how I can put in the x and y coordinates right so that the sun beams will look right" not noticing that I could just insert the angles instead of calculating the coordinates on a line at a certain angle and then reading the angle off it :S

sync on
sync rate 0
cls

center text 320,240,"Press any key to step through the picture"
suspend for key
cls rgb(100,100,200)

`boat
ink rgb(100,20,20),rgb(100,100,200)
for y=280 to 440
   line 70+(y/4),y,570-(y/4),y
next y
box 300,100,340,280
sync
suspend for key

`sails
ink rgb(200,200,200),rgb(100,100,200)
for x=0 to 125
   for y=0 to 140
      if (x+((140-y)/1.5))<90 then dot x+345,y+100 : dot 295-x,y+100
   next y
next x
sync
suspend for key

`waves
ink rgb(0,0,100),rgb(100,100,200)
for x=0 to 639
	ym=(15*sin(x*4))+15
	line x,ym+340,x,479
next x
sync
suspend for key

x1=639
y1=0

`sun
ink rgb(200,200,70),rgb(100,100,200)
for x=600 to 639
   for y=0 to 39
      if SQRT((x-640)^2+(y)^2)<39
			dot x,y
      endif
   next y
next x

for x=550 to 639
   for y=0 to 89
      drawang#=atanfull(y-y1,x-x1)
      if SQRT((x-640)^2+y^2)>50 and SQRT((x-640)^2+y^2)<89
         if (drawang#>90 and drawang#<100) or (drawang#>105 and drawang#<120) or (drawang#>125 and drawang#<140) or (drawang#>145 and drawang#<160) or (drawang#>165 and drawang#<180) then dot x,y
      endif
   next y
next x
suspend for key
end

+ Code Snippet

sync on
sync rate 0
cls

center text 320,240,"Press any key to step through the picture"
suspend for key
cls rgb(100,100,200)



`boat
ink rgb(100,20,20),rgb(100,100,200)
for y=280 to 440
   line 70+(y/4),y,570-(y/4),y
next y
box 300,100,340,280
sync
suspend for key

`sails
ink rgb(200,200,200),rgb(100,100,200)
for x=0 to 125
   for y=0 to 140
      if (x+((140-y)/1.5))<90 then dot x+345,y+100 : dot 295-x,y+100
   next y
next x
sync
suspend for key


`waves
ink rgb(0,0,100),rgb(100,100,200)
for x=0 to 639
	ym=(15*sin(x*4))+15
	line x,ym+340,x,479
next x
sync
suspend for key

x1=639
y1=0

`sun
ink rgb(200,200,70),rgb(100,100,200)
for x=600 to 639
   for y=0 to 39
      if SQRT((x-640)^2+(y)^2)<39
			dot x,y
      endif
   next y
next x

for x=550 to 639
   for y=0 to 89
      drawang#=atanfull(y-y1,x-x1)
      if SQRT((x-640)^2+y^2)>50 and SQRT((x-640)^2+y^2)<89
         if (drawang#>90 and drawang#<100) or (drawang#>105 and drawang#<120) or (drawang#>125 and drawang#<140) or (drawang#>145 and drawang#<160) or (drawang#>165 and drawang#<180) then dot x,y
      endif
   next y
next x
suspend for key
end

Back to top

Profile PM Website

Libervurto

19

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 2nd Nov 2007 17:29 Edited at: 2nd Nov 2007 18:19

Link

@Demon
my code draws a circle

I made an entry out of it.
Anyone can use the function if they like, may prove useful for the challenges. Unlike most of my functions, this one seems quite fast

+ Code Snippet

sw=1024 : sh=768
set display mode sw,sh,32
randomize timer()
hide mouse
sync on : sync rate 0
create bitmap 1,sw,sh
cls rgb(255,255,255)

DO
   red=rnd(155)+100 : green=rnd(155)+100 : blue=rnd(155)+100
   r=rnd(95)+5 : x=rnd(sw-r*2)+r : y=rnd(sh-r*2)+r

   ink rgb(red,green,blue),0
   set current bitmap 1
   fill_circle(x,y,r)
   copy bitmap 1,0
   set current bitmap 0
   sync
LOOP

END

FUNCTION fill_circle(x,y,r)
   for m = 0 to 360
      min = wrapvalue(0-m) : max = wrapvalue(0+m)
      line x+sin(min)*r,y+cos(min)*r,x+sin(max)*r,y+cos(max)*r
      line x+sin(min)*r,y+cos(min)*r-1,x+sin(max)*r,y+cos(max)*r-1
   next m
ENDFUNCTION

Blurry version (some cool colour blending)

+ Code Snippet

sw=1024 : sh=768
set display mode sw,sh,32
randomize timer()
hide mouse
sync on : sync rate 0
create bitmap 1,sw,sh
cls rgb(255,255,255)

DO
   set current bitmap 1
   red=rnd(155)+100 : green=rnd(155)+100 : blue=rnd(155)+100
   r=rnd(95)+5 : x=rnd(sw-r*2)+r : y=rnd(sh-r*2)+r

   ink rgb(red,green,blue),0
   fill_circle(x,y,r)
   blur bitmap 1,1

   copy bitmap 1,0
   set current bitmap 0
   sync
LOOP

END

FUNCTION fill_circle(x,y,r)
   for m = 0 to 360
      min = wrapvalue(0-m) : max = wrapvalue(0+m)
      line x+sin(min)*r,y+cos(min)*r,x+sin(max)*r,y+cos(max)*r
      line x+sin(min)*r,y+cos(min)*r-1,x+sin(max)*r,y+cos(max)*r-1
   next m
ENDFUNCTION

[edit]
I accidentally made this ellipse thing, I'm trying to turn a circle into a square using a formula so I can have rounded squares.
Got the idea from blender

which I just started using and is totally awesome

+ Code Snippet

x=320 : y=240 : r=200 : sq=45
hide mouse
sync on : sync rate 0

DO
   r=rightkey() : l=leftkey()
   sq=sq+r-l

   For a = 0 to 359
      line x+sin(a)*(r+sq-360),y+cos(a)*(r+sq), x+sin(a+1)*(r+sq-360), y+cos(a+1)*(r+sq)
   Next a

   sync : cls
LOOP

OOPS! there are two r variables in there

[edit]
A rotating coin, not very smooth or fast.

+ Code Snippet

x=320 : y=240 : rad=100 : sq=45
hide mouse
sync on : sync rate 0
hiblue = rgb(0,255,255)
loblue = rgb(0,128,255)
create bitmap 1,640,480

DO
   sq = wrapvalue(sq+2)
   if sq>90 and sq<270 then ink loblue,0 else ink hiblue,0

   set current bitmap 1
   For a = 0 to 359
      min = wrapvalue(0-a) : max = wrapvalue(0+a) : `the two points travel along the opposite curves of the circle
      line x+sin(min)*rad,y+cos(min+sq)*rad,x+sin(max)*rad,y+cos(max+sq)*rad
      line x+sin(min)*rad,y+cos(min+sq)*rad,x+sin(max)*rad+1,y+cos(max+sq)*rad+1 : `fiddle line to fill in any gaps

`      line x+sin(a)*rad,y+cos(a+sq)*rad, x+sin(a+1)*rad, y+cos(a+1+sq)*rad
   Next a
   copy bitmap 1,0
   cls
   print sq
   set current bitmap 0

   sync
LOOP

"You must be someone's friend to make comments about them." - MySpace lied.

Back to top

Profile PM Email

Sorry your browser is not supported!

DarkBASIC Discussion / The DB Classic Programming Challenge Thread