July 01, 2022, 01:07:02 AM

News:

Own IWBasic 2.x ? -----> Get your free upgrade to 3.x now.........


1000 Ibasic forum members by Jolly Roger

Started by pistol350, September 04, 2007, 08:53:37 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

pistol350

Roger wrote that program to celebrate the arriving of the 1000th member of the former forum .
come back man, we miss you. :D


'1000 Ibasic forum members
'Ibasic Stardard.Windows
'Jolly Roger Oct 2004
AUTODEFINE "OFF"
DEF win:WINDOW
DEF run,blinknumber,angle,planex,textwidth,textheight:INT
DEF text$:STRING
blinknumber=0:planex=640
text$="1000 IBasic forum members"

DECLARE drawfluffyshape(coreleft:INT,coretop:INT,corewidth:INT,coreheight:INT,lumpiness:FLOAT,colour:INT)

WINDOW win,0, 0, 640, 480,@MINBOX,0,"",main
SETWINDOWCOLOR win,0xFFFF00
SETFONT win,"arial",14,600
GETTEXTSIZE win,text$,textwidth,textheight
'Draw grass
RECT win,0,320,640,160,0xff00,0xff00
'Draw sun
CIRCLE win,100,100,30,0xFFFF,0xFFFF
'Draw rays
FOR angle=0 TO 359 STEP 30
   LINE win,100+40*SIN(angle*6.283/360),100+40*COS(angle*6.283/360),100+70*SIN(angle*6.283/360),100+70*COS(angle*6.283/360),0xFFFF
NEXT angle

'Draw clouds
drawfluffyshape(300,50,150,60,.25,0xFFFFFF)

'Draw tree trunk
RECT win,85,330,25,80,RGB(160,100,0),RGB(160,100,0)
'Draw tree foliage
drawfluffyshape(50,250,100,90,.25,0xA000)

'Draw sheep body
drawfluffyshape(350,350,50,25,.15,0xFFFFFF)
'Draw sheep head
drawfluffyshape(335,345,20,15,.15,0xFFFFFF)
'Draw sheep legs
RECT win,355,365,5,20,0xFFFFFF,0xFFFFFF
RECT win,390,365,5,20,0xFFFFFF,0xFFFFFF

STARTTIMER win,50

run = 1
WAITUNTIL run = 0
CLOSEWINDOW win
END



SUB main
SELECT @CLASS
  CASE @IDCLOSEWINDOW
    run = 0
  CASE @IDTIMER
    IF blinknumber=0
      'Draw eye
      CIRCLE win,345,350,1,0x909090
    ENDIF
    blinknumber=blinknumber+1
    IF blinknumber=40
      'Erase eye
      CIRCLE win,345,350,1,0xFFFFFF
      blinknumber=0
    ENDIF
    planex=planex-2
    'Reset plane to right if gone off left of screen
    IF planex+120+textwidth<-50 THEN planex=640
    GOSUB drawplaneandbanner
ENDSELECT
RETURN


SUB drawfluffyshape(coreleft:INT,coretop:INT,corewidth:INT,coreheight:INT,lumpiness:FLOAT,colour:INT)
  DEF circleradius,circlecentrex,circlecentrey,ellipsecentrex,ellipsecentrey:INT
  DEF minradius,maxradius,anglestep:INT
  DEF radangle:FLOAT
  ELLIPSE win,coreleft,coretop,corewidth,coreheight,colour,colour
  minradius=(corewidth+coreheight)*lumpiness/4:maxradius=(corewidth+coreheight)*lumpiness/2
  ellipsecentrex=coreleft+corewidth/2
  ellipsecentrey=coretop+coreheight/2
  anglestep=lumpiness*100
  IF anglestep<1 THEN anglestep=1
  FOR angle=0 TO 359 STEP anglestep
    circleradius=minradius+RND(maxradius-minradius)
    radangle=angle*6.283/360
    circlecentrex=ellipsecentrex+(corewidth/2-circleradius/3)*SIN(radangle)
    circlecentrey=ellipsecentrey+(coreheight/2-circleradius/3)*COS(radangle)
    CIRCLE win,circlecentrex,circlecentrey,circleradius,colour,colour
  NEXT angle
RETURN


SUB drawplaneandbanner
   SETLINESTYLE win,@LSSOLID,12
   ELLIPSE win,planex,200,100,30,0xFFFF00,255
   SETLINESTYLE win,@LSSOLID,1
   ELLIPSE win,planex+80,200,10,20,255,255
   ELLIPSE win,planex+30,210,30,5,200
   LINE win,planex+93,215,planex+120,215,0
   BACKPEN win,0xFFFFFF
   MOVE win,planex+120,203:PRINT win,text$
   BACKPEN win,0xFFFF00
   MOVE win,planex+120+textwidth,203:PRINT win," "
RETURN
Regards,

Peter B.

Steven Picard