Edit : zip file attached.
My godnes!!!!!!
incredible!! :o
How could he manage to write this ????
[code]
'Line extrusion editor
'Jolly Roger Oct 2004
AUTODEFINE "OFF"
DEF win,previewwin:WINDOW
DEF run,n,left,top,width,height,usablewidth,usableheight:INT
DEF linenumber,point,maxnumberoflines,maxnumberofpointsperline:INT
DEF xmult,ymult:FLOAT
CONST maxnumberoflines=50
CONST maxnumberofpointsperline=1000
DEF numberofpoints,pointx[maxnumberofpointsperline,maxnumberoflines],pointy[maxnumberofpointsperline,maxnumberoflines]:INT
DEF lineclosed[maxnumberoflines],selectedpoint,selectedline,numberoflines:INT
DEF numberofpointsinline[maxnumberoflines],mode,addlines,editpoints,pointsinline:INT
DEF closeoropenlinebutton,addlinesradiobutton,editpointsradiobutton,instructionseditbox:INT
DEF threeDpreviewbutton,insertpointbutton,drawingareasize,drawingarealeft:INT
DEF lastrubberbandx,lastrubberbandy,radiobuttonheight,widtheditbox,heighteditbox:INT
DEF heighttextbox,widthtextbox,linewidth,extrusionheight,addnewpoint:INT
DEF xdiff,ydiff,closingpreviewwin:INT
DEF distance1,distance2,distance3:FLOAT
DEF newline:STRING
DEF drawlinesinstructions[2000],editpointsinstructions[2000]:ISTRING
'3D preview variables and declarations
DEF timesincelastframe,lastframetime,scene,camera,light,shape:INT
DECLARE extrusionobject(objectparent:INT)
DECLARE lineangle(x1:INT,y1:INT,x2:INT,y2:INT)
closeoropenlinebutton=1
addlinesradiobutton=2
editpointsradiobutton=3
instructionseditbox=4
threeDpreviewbutton=5
insertpointbutton=6
widtheditbox=7
heighteditbox=8
widthtextbox=9
heighttextbox=10
CONST addlines=0
CONST editpoints=1
mode=addlines
numberofpoints=0:selectedpoint=-1:selectedline=-1
numberofpointsinline[0]=0:numberoflines=0:lastrubberbandx=-1
closingpreviewwin=0
newline=CHR$(13)+CHR$(10)
WINDOW win,0,0,640,480,@MAXIMIZED|@MAXBOX,0,"Test",mainwindow
GETSIZE win,left,top,width,height
GETSCREENSIZE width,n
CLOSEWINDOW win
WAITUNTIL win=0
WINDOW win,0,0,width,height,@MINBOX|@NOAUTODRAW,0,"Extruder",mainwindow
'Add File menu
MENU win, "T, File, 0, 0" , "I,Load, 0, 1" , "I,Save, 0 ,2", "I,Save as IBasic subroutine, 0 ,3"
ENABLEMENUITEM win,2,0
ENABLEMENUITEM win,3,0
GETCLIENTSIZE win,left,top,usablewidth,usableheight
xmult=usablewidth/634:ymult=usableheight/436
drawingareasize=usableheight:drawingarealeft=usablewidth-usableheight
GOSUB createcontrols
'Set up timer
DECLARE "kernel32",GetTickCount(),INT
DECLARE clickedonlastpointinline()
run = 1
WAITUNTIL run=0
CLOSEWINDOW win
END
SUB mainwindow
SELECT @class
CASE @IDCLOSEWINDOW
run=0
CASE @IDCHAR
IF @CODE = ASC("Q")| @CODE=ASC("q") THEN run = 0
CASE @IDKEYDOWN
IF @CODE=0x2E
'Delete key pressed
IF mode=editpoints & selectedpoint<>-1 THEN GOSUB deletepoint
ENDIF
CASE @IDPAINT
RECT win,drawingarealeft,0,drawingareasize,drawingareasize,0,0
GOSUB redrawlines
CASE @IDMOUSEMOVE
IF @MOUSEX>=drawingarealeft+3 & selectedpoint<>-1
'Mouse is on drawing area and a point is selected
GOSUB mousemovehandler
ENDIF
CASE @IDMENUPICK
SELECT @MENUNUM
CASE 1:GOSUB loadlines
CASE 2
linewidth=VAL(GETCONTROLTEXT(win,widtheditbox))
extrusionheight=VAL(GETCONTROLTEXT(win,heighteditbox))
IF linewidth=0 | extrusionheight=0
MESSAGEBOX win,"Width and height should be greater than zero","Oops",64
ELSE
GOSUB savelines
ENDIF
CASE 3
linewidth=VAL(GETCONTROLTEXT(win,widtheditbox))
extrusionheight=VAL(GETCONTROLTEXT(win,heighteditbox))
IF linewidth=0 | extrusionheight=0
MESSAGEBOX win,"Width and height should be greater than zero","Oops",64
ELSE
GOSUB deletelineswithonepoint
IF numberoflines>0 THEN GOSUB saveasibasicsubroutine
ENDIF
ENDSELECT
CASE @IDLBUTTONDN
IF @MOUSEX>=drawingarealeft+3
'Click on drawing area
IF mode=addlines
lastrubberbandx=-1
IF clickedonlastpointinline()=0 & numberoflines<maxnumberoflines
IF selectedpoint=-1
'Start new line
pointx[0,numberoflines]=@MOUSEX:pointy[0,numberoflines]=@MOUSEY
numberofpointsinline[numberoflines]=1
lineclosed[numberoflines]=0
selectedline=numberoflines:selectedpoint=0
numberoflines=numberoflines+1
'Disable close/open line button
ENABLECONTROL win,closeoropenlinebutton,0
SETCONTROLTEXT win,closeoropenlinebutton,"Close line"
ENABLECONTROL win,editpointsradiobutton,1
GOSUB redrawlines
ELSE
IF numberofpointsinline[selectedline]<100 & lineclosed[selectedline]=0
'Add new point to selected line
pointsinline=numberofpointsinline[selectedline]
pointx[pointsinline,selectedline]=@MOUSEX
pointy[pointsinline,selectedline]=@MOUSEY
selectedpoint=pointsinline
numberofpointsinline[selectedline]=pointsinline+1
IF numberofpointsinline[selectedline]>1 THEN ENABLECONTROL win,threeDpreviewbutton,1
'Delete red square from last selected point
RECT win,pointx[selectedpoint-1,selectedline]-2*xmult,pointy[selectedpoint-1,selectedline]-2*ymult,4*xmult,4*ymult,0,0
GOSUB redrawlines
IF numberofpointsinline[selectedline]<4 THEN GOSUB setcontrols
ENDIF
ENDIF
ENDIF
ELSE
'Edit point mode
GOSUB checkifclickedonpoint
ENDIF
ENDIF
CASE @IDRBUTTONDN
IF mode=addlines & selectedpoint<>-1
'End the current line
IF lastrubberbandx<>-1
'Erase rubber band line
LINE win,pointx[selectedpoint,selectedline],pointy[selectedpoint,selectedline],lastrubberbandx,lastrubberbandy,0
lastrubberbandx=-1
ENDIF
ENABLECONTROL win,closeoropenlinebutton,0
selectedline=-1:selectedpoint=-1
GOSUB redrawlines
ENDIF
CASE @IDCONTROL
IF @CONTROLID=closeoropenlinebutton
'Close/open selected line button pressed
IF selectedpoint<>-1 & mode=addlines
IF lineclosed[selectedline]=1
'Line currently closed.Open it
lineclosed[selectedline]=0
pointsinline=numberofpointsinline[selectedline]
'Erase line from last point to first point
LINE win,pointx[pointsinline-1,selectedline],pointy[pointsinline-1,selectedline],pointx[0,selectedline],pointy[0,selectedline],0
GOSUB redrawlines
SETCONTROLTEXT win,closeoropenlinebutton,"Close line"
ELSE
'Line currently open.Close it
lineclosed[selectedline]=1
'Erase last rubber band line
IF lastrubberbandx<>-1
LINE win,pointx[selectedpoint,selectedline],pointy[selectedpoint,selectedline],lastrubberbandx,lastrubberbandy,0
ENDIF
selectedline=-1:selectedpoint=-1
ENABLECONTROL win,closeoropenlinebutton,0
GOSUB redrawlines
SETCONTROLTEXT win,closeoropenlinebutton,"Open line"
ENDIF
ENDIF
ENDIF
IF @CONTROLID=addlinesradiobutton
selectedline=-1:selectedpoint=-1:lastrubberbandx=-1
ENABLECONTROL win,closeoropenlinebutton,0
SHOWWINDOW win,1,closeoropenlinebutton
SHOWWINDOW win,1,threeDpreviewbutton
IF numberofpointsinline[0]<2
ENABLECONTROL win,threeDpreviewbutton,0
ELSE
ENABLECONTROL win,threeDpreviewbutton,1
ENDIF
SHOWWINDOW win,0,insertpointbutton
RECT win,drawingarealeft,0,drawingareasize,drawingareasize,0,0
mode=addlines
GOSUB redrawlines
SETCONTROLTEXT win,instructionseditbox,drawlinesinstructions
ENDIF
IF @CONTROLID=editpointsradiobutton
SHOWWINDOW win,0,closeoropenlinebutton
SHOWWINDOW win,1,insertpointbutton
ENABLECONTROL win,insertpointbutton,0
mode=editpoints
selectedpoint=-1:selectedline=-1
GOSUB redrawlines
SETCONTROLTEXT win,instructionseditbox,editpointsinstructions
ENDIF
IF @CONTROLID=threeDpreviewbutton
linewidth=VAL(GETCONTROLTEXT(win,widtheditbox))
extrusionheight=VAL(GETCONTROLTEXT(win,heighteditbox))
IF linewidth=0 | extrusionheight=0
MESSAGEBOX win,"Width and height should be greater than zero","Oops",64
ELSE
GOSUB deletelineswithonepoint
IF numberoflines>0 THEN GOSUB setup3Dpreview
ENDIF
ENDIF
IF @CONTROLID=insertpointbutton THEN GOSUB insertpoint
ENDSELECT
RETURN
SUB redrawlines
DEF linecolour,numberofpointsincurrentline,x,y:INT
IF numberoflines>0
FOR linenumber=0 TO numberoflines-1
numberofpointsincurrentline=numberofpointsinline[linenumber]
IF numberofpointsincurrentline>1
IF mode=addlines
'Set line colour depending on whether line is selected
IF linenumber=selectedline
linecolour=0xFFFF
ELSE
linecolour=0xFFFFFF
ENDIF
'Draw lines
MOVE win,pointx[0,linenumber],pointy[0,linenumber]
FOR point=1 TO numberofpointsincurrentline-1
LINE win,pointx[point,linenumber],pointy[point,linenumber],linecolour
NEXT point
'Close line if needed
IF lineclosed[linenumber]
LINE win,pointx[0,linenumber],pointy[0,linenumber],linecolour
ENDIF
ELSE
'In edit points mode
'Draw lines
MOVE win,pointx[0,linenumber],pointy[0,linenumber]
FOR point=1 TO numberofpointsincurrentline-1
'Set line segment colour depending on whether corresponding point is selected
IF selectedpoint=point-1
linecolour=0xFFFF
ELSE
linecolour=0xFFFFFF
ENDIF
LINE win,pointx[point,linenumber],pointy[point,linenumber],linecolour
NEXT point
'Close line if needed
IF lineclosed[linenumber]
'Set line segment colour depending on whether corresponding point is selected
IF selectedpoint=numberofpointsincurrentline-1
linecolour=0xFFFF
ELSE
linecolour=0xFFFFFF
ENDIF
LINE win,pointx[0,linenumber],pointy[0,linenumber],linecolour
ENDIF
ENDIF
ENDIF
'Draw selectable points
IF mode=addlines
x=pointx[numberofpointsincurrentline-1,linenumber]
y=pointy[numberofpointsincurrentline-1,linenumber]
RECT win,x-2*xmult,y-2*ymult,4*xmult,4*ymult,0xFF00,0xFF00
ELSE
'In edit points mode
FOR point=0 TO numberofpointsinline[linenumber]-1
x=pointx[point,linenumber]
y=pointy[point,linenumber]
RECT win,x-2*xmult,y-2*ymult,4*xmult,4*ymult,0xFF00,0xFF00
NEXT point
ENDIF
'Draw selected point in red
IF selectedpoint<>-1
x=pointx[selectedpoint,selectedline]
y=pointy[selectedpoint,selectedline]
RECT win,x-2*xmult,y-2*ymult,4*xmult,4*ymult,255,255
ENDIF
NEXT linenumber
ENDIF
RETURN
SUB clickedonlastpointinline()
DEF clickedonpoint,numberofline,dx,dy,distance,nearestline,mindist,numberofpointsincurrentline:INT
clickedonpoint=0
IF numberoflines>0
mindist=10000:nearestline=-1
FOR numberofline=0 TO numberoflines-1
numberofpointsincurrentline=numberofpointsinline[numberofline]
dx=@MOUSEX-pointx[numberofpointsincurrentline-1,numberofline]
dy=@MOUSEY-pointy[numberofpointsincurrentline-1,numberofline]
distance=SQRT(dx*dx+dy*dy)
IF distance<mindist & distance<5*xmult
mindist=distance:nearestline=numberofline
ENDIF
NEXT numberofline
IF nearestline<>-1
'Clicked on end point of a line
selectedline=nearestline:selectedpoint=numberofpointsinline[selectedline]-1
clickedonpoint=1
IF numberofpointsinline[selectedline]>2
'Enable close/open line button
ENABLECONTROL win,closeoropenlinebutton,1
IF lineclosed[selectedline]
SETCONTROLTEXT win,closeoropenlinebutton,"Open line"
ELSE
SETCONTROLTEXT win,closeoropenlinebutton,"Close line"
ENDIF
ELSE
'Disable close/open line button
ENABLECONTROL win,closeoropenlinebutton,0
ENDIF
GOSUB redrawlines
ENDIF
ENDIF
RETURN clickedonpoint
SUB checkifclickedonpoint
DEF numberofline,dx,dy,distance,nearestline,mindist:INT
DEF numberofpointsincurrentline,nearestpoint:INT
IF numberoflines>0
mindist=10000:nearestline=-1
FOR numberofline=0 TO numberoflines-1
numberofpointsincurrentline=numberofpointsinline[numberofline]
FOR point=0 TO numberofpointsincurrentline-1
dx=@MOUSEX-pointx[point,numberofline]
dy=@MOUSEY-pointy[point,numberofline]
distance=SQRT(dx*dx+dy*dy)
IF distance<mindist & distance<5*xmult
mindist=distance:nearestline=numberofline:nearestpoint=point
ENDIF
NEXT point
NEXT numberofline
IF nearestline<>-1
'Clicked on a point
selectedline=nearestline:selectedpoint=nearestpoint
IF selectedpoint<>numberofpointsinline[selectedline]-1 | lineclosed[selectedline]
ENABLECONTROL win,insertpointbutton,1
ELSE
ENABLECONTROL win,insertpointbutton,0
ENDIF
GOSUB redrawlines
ENDIF
ENDIF
RETURN
SUB loadlines
DEF linedatafile:FILE
DEF filename,textline:STRING
DEF error,commaposn:INT
filename=FILEREQUEST("Choose line data file to load",win,1,"Line data files|*.linedata.txt||",".linedata.txt",0,GETSTARTPATH)
IF filename<>""
error=OPENFILE(linedatafile,filename,"R")
IF error=0
READ linedatafile,textline
SETCONTROLTEXT win,widtheditbox,textline
READ linedatafile,textline
SETCONTROLTEXT win,heighteditbox,textline
READ linedatafile,textline
numberoflines=VAL(textline)
FOR linenumber=0 TO numberoflines-1
READ linedatafile,textline
lineclosed[linenumber]=VAL(textline)
READ linedatafile,textline
numberofpointsinline[linenumber]=VAL(textline)
FOR point=0 TO numberofpointsinline[linenumber]-1
READ linedatafile,textline
pointx[point,linenumber]=drawingarealeft+VAL(textline)*drawingareasize/1000
commaposn=INSTR(textline,",")
textline=MID$(textline,commaposn+1)
pointy[point,linenumber]=VAL(textline)*drawingareasize/1000
NEXT point
NEXT linenumber
CLOSEFILE linedatafile
'Clear drawing area
RECT win,drawingarealeft,0,drawingareasize,drawingareasize,0,0
GOSUB redrawlines
IF numberoflines>1 | numberofpointsinline[0]>1
ENABLECONTROL win,editpointsradiobutton,1
ENABLECONTROL win,threeDpreviewbutton,1
'Enable save options on file menu
ENABLEMENUITEM win,2,1
ENABLEMENUITEM win,3,1
ENDIF
ENDIF
ENDIF
RETURN
SUB savelines
DEF linedatafile:FILE
DEF filename,textline:STRING
DEF error:INT
filename=FILEREQUEST("Choose name for saved line data",win,0,"Line data files|*.linedata.txt||",".linedata.txt",0,GETSTARTPATH)
IF filename<>""
error=OPENFILE(linedatafile,filename,"W")
IF error=0
WRITE linedatafile,LTRIM$(STR$(linewidth))
WRITE linedatafile,LTRIM$(STR$(extrusionheight))
WRITE linedatafile,LTRIM$(STR$(numberoflines))
FOR linenumber=0 TO numberoflines-1
WRITE linedatafile,LTRIM$(STR$(lineclosed[linenumber]))
WRITE linedatafile,LTRIM$(STR$(numberofpointsinline[linenumber]))
FOR point=0 TO numberofpointsinline[linenumber]-1
textline=LTRIM$(STR$((pointx[point,linenumber]-drawingarealeft)*1000/drawingareasize ))+","+LTRIM$(STR$(pointy[point,linenumber]*1000/drawingareasize))
WRITE linedatafile,textline
NEXT point
NEXT linenumber
CLOSEFILE linedatafile
ENDIF
ENDIF
RETURN
SUB saveasibasicsubroutine
DEF ibsub:FILE
DEF filename,textline:STRING
DEF error,numberofpointswritten,numberswritten,x,y:INT
filename= FILEREQUEST ("Please choose name for IBasic subroutine",win,0,"Extrusion object files|*.extrusion_object.txt||",".extrusion_object.txt",0,GETSTARTPATH)
IF filename<>""
error=OPENFILE(ibsub,filename,"W")
IF error=0
WRITE ibsub,"SUB readextrusionobjectdata"
WRITE ibsub,"linewidth="+LTRIM$(STR$(linewidth))
WRITE ibsub,"extrusionheight="+LTRIM$(STR$(extrusionheight))
WRITE ibsub,"numberoflines="+LTRIM$(STR$(numberoflines))
numberswritten=0
textline="lineclosed="
FOR linenumber=0 TO numberoflines-1
IF RIGHT$(textline,1)<>"=" THEN textline=textline+","
textline=textline+LTRIM$(STR$(lineclosed[linenumber]))
numberswritten=numberswritten+1
IF LEN(textline)>65 | linenumber=numberoflines-1
WRITE ibsub,textline
IF LEN(textline)>65
textline="lineclosed["+LTRIM$(STR$(numberswritten))+"]="
ENDIF
ENDIF
NEXT linenumber
numberswritten=0
textline="numberofpointsinline="
FOR linenumber=0 TO numberoflines-1
IF RIGHT$(textline,1)<>"=" THEN textline=textline+","
textline=textline+LTRIM$(STR$(numberofpointsinline[linenumber]))
numberswritten=numberswritten+1
IF LEN(textline)>65 | linenumber=numberoflines-1
WRITE ibsub,textline
IF LEN(textline)>65
textline="numberofpointsinline["+LTRIM$(STR$(numberswritten))+"]="
ENDIF
ENDIF
NEXT linenumber
numberofpointswritten=0
textline="pointx="
FOR linenumber=0 TO numberoflines-1
FOR point=0 TO numberofpointsinline[linenumber]-1
IF RIGHT$(textline,1)<>"=" THEN textline=textline+","
x=(pointx[point,linenumber]-drawingarealeft-drawingareasize/2)*1000/drawingareasize
textline=textline+LTRIM$(STR$(x))
numberofpointswritten=numberofpointswritten+1
IF LEN(textline)>65 | ((point=numberofpointsinline[linenumber]-1)&(linenumber=numberoflines-1))
WRITE ibsub,textline
IF LEN(textline)>65
textline="pointx["+LTRIM$(STR$(numberofpointswritten))+"]="
ENDIF
ENDIF
NEXT point
NEXT linenumber
numberofpointswritten=0
textline="pointy="
FOR linenumber=0 TO numberoflines-1
FOR point=0 TO numberofpointsinline[linenumber]-1
IF RIGHT$(textline,1)<>"=" THEN textline=textline+","
y=((drawingareasize/2)-pointy[point,linenumber])*1000/drawingareasize
textline=textline+LTRIM$(STR$(y))
numberofpointswritten=numberofpointswritten+1
IF LEN(textline)>65 | ((point=numberofpointsinline[linenumber]-1)&(linenumber=numberoflines-1))
WRITE ibsub,textline
IF LEN(textline)>65
textline="pointy["+LTRIM$(STR$(numberofpointswritten))+"]="
ENDIF
ENDIF
NEXT point
NEXT linenumber
WRITE ibsub,"RETURN"
CLOSEFILE ibsub
ENDIF
ENDIF
RETURN
SUB insertpoint
pointsinline=numberofpointsinline[selectedline]
'Move point data down in arrays to make room for new point
FOR point=pointsinline TO selectedpoint+1 STEP -1
pointx[point+1,selectedline]=pointx[point,selectedline]
pointy[point+1,selectedline]=pointy[point,selectedline]
NEXT point
'Add new point
IF lineclosed[selectedline] & selectedpoint=numberofpointsinline-1
'Erase selected line segment
LINE win,pointx[selectedpoint,selectedline],pointy[selectedpoint,selectedline],pointx[0,selectedline],pointy[0,selectedline],0
pointx[selectedpoint+1,selectedline]=(pointx[selectedpoint,selectedline]+pointx[0,selectedline])/2
pointy[selectedpoint+1,selectedline]=(pointy[selectedpoint,selectedline]+pointy[0,selectedline])/2
ELSE
pointx[selectedpoint+1,selectedline]=(pointx[selectedpoint,selectedline]+pointx[selectedpoint+2,selectedline])/2
pointy[selectedpoint+1,selectedline]=(pointy[selectedpoint,selectedline]+pointy[selectedpoint+2,selectedline])/2
'Erase selected line segment
LINE win,pointx[selectedpoint,selectedline],pointy[selectedpoint,selectedline],pointx[selectedpoint+2,selectedline],pointy[selectedpoint+2,selectedline],0
ENDIF
selectedpoint=selectedpoint+1
numberofpointsinline[selectedline]=numberofpointsinline[selectedline]+1
GOSUB redrawlines
RETURN
SUB deletepoint
pointsinline=numberofpointsinline[selectedline]
IF selectedpoint<>pointsinline-1
'Selected point is not last/only point in line
FOR point=selectedpoint TO pointsinline-2
pointx[point,selectedline]=pointx[point+1,selectedline]
pointy[point,selectedline]=pointy[point+1,selectedline]
NEXT point
ENDIF
numberofpointsinline[selectedline]=numberofpointsinline[selectedline]-1
IF selectedpoint>numberofpointsinline[selectedline]-1
selectedpoint=selectedpoint-1
ENDIF
IF numberofpointsinline[selectedline]<3 THEN lineclosed[selectedline]=0
IF numberofpointsinline[selectedline]=0
'Deleted only point in line.Delete line
IF selectedline<>numberoflines-1
'Move point array data up
FOR linenumber=selectedline TO numberoflines-2
pointsinline=numberofpointsinline[selectedline+1]
FOR point=0 TO pointsinline-1
pointx[point,linenumber]=pointx[point,linenumber+1]
pointy[point,linenumber]=pointx[point,linenumber+1]
NEXT point
NEXT linenumber
ENDIF
numberoflines=numberoflines-1
selectedpoint=-1:selectedline=-1
ENDIF
'Clear drawing area
RECT win,drawingarealeft,0,drawingareasize,drawingareasize,0,0
IF numberoflines>0
GOSUB redrawlines
ELSE
ENABLECONTROL win,insertpointbutton,0
ENABLEMENUITEM win,2,0
ENABLEMENUITEM win,3,0
ENDIF
RETURN
SUB createcontrols
'Create close/open line button
CONTROL win,"B,Close line,35*xmult,80*ymult,150*xmult,20*ymult,0,closeoropenlinebutton"
ENABLECONTROL win,closeoropenlinebutton,0
'Create 3D preview button
CONTROL win,"B,3D preview,35*xmult,110*ymult,150*xmult,20*ymult,0,threeDpreviewbutton"
SHOWWINDOW win,1,threeDpreviewbutton
ENABLECONTROL win,threeDpreviewbutton,0
'Create insert point button
CONTROL win,"B,Insert point,35*xmult,80*ymult,150*xmult,20*ymult,0,insertpointbutton"
SHOWWINDOW win,0,insertpointbutton
'Create mode radio buttons
radiobuttonheight=20*ymult
CONTROL win,"R,Add lines mode,35*xmult,20*ymult,150*xmult,radiobuttonheight,@GROUP,addlinesradiobutton"
CONTROL win,"R,Edit points mode,35*xmult,20*ymult+radiobuttonheight,150*xmult,radiobuttonheight,0,editpointsradiobutton"
SETSTATE win,addlinesradiobutton,1
ENABLECONTROL win,editpointsradiobutton,0
'Create instructions editbox
CONTROL win,"E,,0,190*ymult,drawingarealeft,usableheight-190*ymult,@CTEDITMULTI|@VSCROLL,instructionseditbox"
drawlinesinstructions="This programme allow you to draw lines which are extruded to create 3D objects."
drawlinesinstructions=drawlinesinstructions+newline+"A single straight line will become a cuboid while a circle will become a hoop."
drawlinesinstructions=drawlinesinstructions+newline+newline+"Click on the drawing area to start a line."
drawlinesinstructions=drawlinesinstructions+"If you release the mouse button and click elsewhere a straight line will be drawn between these two points."
drawlinesinstructions=drawlinesinstructions+"To draw a curved line,move the mouse holding the left button down."
drawlinesinstructions=drawlinesinstructions+newline+"To select an existing line click on the green square at the end of it."
drawlinesinstructions=drawlinesinstructions+newline+"Right click to end the current line."
drawlinesinstructions=drawlinesinstructions+newline+"Click on the Close line button to close a line and on the Open line button to reopen it."
drawlinesinstructions=drawlinesinstructions+newline+"Click on the Edit points radio button to change mode so that individual line points can be deleted,added or moved."
drawlinesinstructions=drawlinesinstructions+newline+"Click on the 3D preview button to preview the 3D object created from the lines."
drawlinesinstructions=drawlinesinstructions+newline+newline+"Try to avoid sharp angles as they can cause problems"
SETCONTROLTEXT win,instructionseditbox,drawlinesinstructions
editpointsinstructions="Click on a point (green square) to select it."
editpointsinstructions=editpointsinstructions+newline+"Once a point is selected you have three options:"
editpointsinstructions=editpointsinstructions+newline+"1.Delete it by pressing the Delete key."
editpointsinstructions=editpointsinstructions+newline+"2.Move it by moving the mouse with the left button down."
editpointsinstructions=editpointsinstructions+newline+"3.Insert a point in the highlighted line segment (if any) by clicking the Insert point button."
editpointsinstructions=editpointsinstructions+newline+newline+"Return to Add lines mode by clicking on the Add lines mode radio button."
'Create width editbox.Accepts up to 3 numbers
CONTROL win,"E,,150*xmult,138*ymult,30*xmult,20*ymult,@CTEDITNUMBER,widtheditbox"
CONTROLCMD win,widtheditbox,@EDSETLIMITTEXT,3
SETCONTROLTEXT win,widtheditbox,"20"
'Create static text box
CONTROL win,"T,Line width,40*xmult,141*ymult,100*xmult,20*ymult,@CTEDITNUMBER,widthtextbox"
SETCONTROLCOLOR win,widthtextbox,0,0xFFFFFF
'Create height editbox.Accepts up to 3 numbers
CONTROL win,"E,,150*xmult,162*ymult,30*xmult,20*ymult,@CTEDITNUMBER,heighteditbox"
CONTROLCMD win,heighteditbox,@EDSETLIMITTEXT,3
'Create static text box
CONTROL win,"T,Extrusion height,30*xmult,165*ymult,110*xmult,20*ymult,@CTEDITNUMBER,heighttextbox"
SETCONTROLCOLOR win,heighttextbox,0,0xFFFFFF
SETCONTROLTEXT win,heighteditbox,"20"
RETURN
SUB setup3Dpreview
DEF error:INT
'Open a window
WINDOW previewwin,0,0,640,480,@NOAUTODRAW,0,"",previewwindowhandler
DRAWMODE previewwin,@TRANSPARENT
FRONTPEN previewwin,0xFFFFFF
'Create a 3D screen for object preview
error=CREATE3DSCREEN(previewwin,640,480,16)
IF error<>0
MESSAGEBOX previewwin, "Could not create Direct3D screen","Error"
CLOSEWINDOW previewwin
END
ENDIF
closingpreviewwin=0
D3DSETQUALITY previewwin,@LIGHTON | @FILLSOLID | @SHADEGOURAUD
'Hide cursor
SETCURSOR previewwin,@CSCUSTOM,0
'The parent scene frame
scene = D3DSCENE(previewwin)
D3DCOMMAND scene,@SETSCENEBACKCOLOR,.2,.2,1
'Create and position the camera
camera = D3DCAMERA(scene)
D3DCOMMAND camera,@SETPOSITION,scene,0,0,-2000
D3DCOMMAND camera,@SETORIENTATION,scene,0,0,1,0,1,0
'Create and orient light source
light = D3DLIGHT(scene,@LIGHTDIRECTIONAL,1,1,1)
D3DCOMMAND light,@SETORIENTATION,scene,0,0,1, 0,1,0
'Create object by extrusion
shape=extrusionobject(scene)
D3DCOMMAND shape,@SETROTATION,scene,0,1,0,.008
lastframetime=GetTickCount()-1
RETURN
SUB previewwindowhandler
SELECT @class
CASE @IDKEYDOWN
IF @CODE=(0x1B) & closingpreviewwin=0
closingpreviewwin=1
'Escape key pressed
'Delete all the frames
D3DDELETE light
D3DDELETE camera
D3DDELETE shape
D3DDELETE scene
CLOSEWINDOW previewwin
WAITUNTIL previewwin=0
ENDIF
CASE @IDDXUPDATE
'Find time since last frame to make things run at a constant speed
timesincelastframe=GetTickCount()-lastframetime
IF timesincelastframe>2 & closingpreviewwin=0
lastframetime=GetTickCount()
'Move the frames according to their current rotation, direction and velocity
D3DMOVE previewwin,timesincelastframe/8
'Render the scene to the DirectX surface
D3DRENDER scene,camera
'Add any 2D elements after the scene is rendered.
MOVE previewwin,5,5
PRINT previewwin,"Press Esc key to return to editor"
'Show the DirectX surface
DXFLIP previewwin,0,0
ENDIF
ENDSELECT
RETURN
SUB extrusionobject(objectparent)
DEF objecthandle,pointsinline,vertex0[1000],vertex1[1000],vertex2[1000],vertex3[1000],verticescreated:INT
DEF faceinfo[9],topfacenormal,bottomfacenormal,actualhalfwidth:INT
DEF endfacenormal1,endfacenormal2,normal1,normal2,pointsused:INT
DEF linesegmentangle[1000],pointangle[1000],linesegmentangledifference[1000]:FLOAT
DEF x[50000],y[50000]:INT
DEF halfextrusionheight:FLOAT
halfextrusionheight=extrusionheight/2.0
'Convert pointx,y array data to x,y array data
pointsused=0
FOR linenumber=0 TO numberoflines-1
pointsinline=numberofpointsinline[linenumber]
FOR point=0 TO pointsinline-1
x[pointsused]=(pointx[point,linenumber]-drawingarealeft-.5*drawingareasize)*1000/drawingareasize
y[pointsused]=(drawingareasize/2-pointy[point,linenumber])*1000/drawingareasize
pointsused=pointsused+1
NEXT point
NEXT linenumber
pointsused=0
objecthandle=D3DSHAPE(objectparent,@SHAPECUSTOM)
FOR linenumber=0 TO numberoflines-1
'Work out line angles
pointsinline=numberofpointsinline[linenumber]
linesegmentangledifference[0]=0:linesegmentangledifference[pointsinline-1]=0
FOR point=0 TO pointsinline-2
linesegmentangle[point]=lineangle(x[pointsused+point],y[pointsused+point],x[pointsused+point+1],y[pointsused+point+1])
NEXT point
IF lineclosed[linenumber]
linesegmentangle[pointsinline-1]=lineangle(x[pointsused+pointsinline-1],y[pointsused+pointsinline-1],x[pointsused],y[pointsused])
ENDIF
'Work out angles at points
IF lineclosed[linenumber]=0
pointangle[0]=linesegmentangle[0]
ELSE
linesegmentangledifference[0]=linesegmentangle[0]-linesegmentangle[pointsinline-1]
IF ABS(linesegmentangledifference[0])>3.142
linesegmentangledifference[0]=linesegmentangledifference[0]-6.283*SGN(linesegmentangledifference[0])
ENDIF
pointangle[0]=linesegmentangle[pointsinline-1]+linesegmentangledifference[0]/2
ENDIF
IF pointsinline>2
FOR point=1 TO pointsinline-2
linesegmentangledifference[point]=linesegmentangle[point]-linesegmentangle[point-1]
IF ABS(linesegmentangledifference[point])>3.142
linesegmentangledifference[point]=linesegmentangledifference[point]-6.283*SGN(linesegmentangledifference[point])
ENDIF
pointangle[point]=linesegmentangle[point-1]+linesegmentangledifference[point]/2
NEXT point
ENDIF
IF lineclosed[linenumber]=0
pointangle[pointsinline-1]=linesegmentangle[pointsinline-2]
ELSE
linesegmentangledifference[pointsinline-1]=linesegmentangle[pointsinline-1]-linesegmentangle[pointsinline-2]
IF ABS(linesegmentangledifference[pointsinline-1])>3.142
linesegmentangledifference[pointsinline-1]=linesegmentangledifference[pointsinline-1]-6.283*SGN(linesegmentangledifference[pointsinline-1])
ENDIF
pointangle[pointsinline-1]=linesegmentangle[pointsinline-2]+linesegmentangledifference[pointsinline-1]/2
ENDIF
'Create vertices.Four per point in line
FOR point=0 TO pointsinline-1
'Set vertex spacing according to angle between line segments
IF (point=0 | point=pointsinline-1) & lineclosed[linenumber]=0
actualhalfwidth=.5*linewidth
ELSE
IF ABS(linesegmentangledifference[point])<2.64
actualhalfwidth=.5*linewidth/COS(ABS(linesegmentangledifference[point]/2))
ELSE
actualhalfwidth=2*linewidth
ENDIF
ENDIF
vertex0[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,x[pointsused+point]-actualhalfwidth*cos(pointangle[point]),y[pointsused+point]+actualhalfwidth*SIN(pointangle[point]),halfextrusionheight)
vertex1[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,x[pointsused+point]+actualhalfwidth*cos(pointangle[point]),y[pointsused+point]-actualhalfwidth*SIN(pointangle[point]),halfextrusionheight)
vertex2[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,x[pointsused+point]+actualhalfwidth*COS(pointangle[point]),y[pointsused+point]-actualhalfwidth*SIN(pointangle[point]),-1*halfextrusionheight)
vertex3[point]=D3DCOMMAND (objecthandle,@ADDVERTEX,x[pointsused+point]-actualhalfwidth*COS(pointangle[point]),y[pointsused+point]+actualhalfwidth*SIN(pointangle[point]),-1*halfextrusionheight)
NEXT point
'Create top faces
topfacenormal=D3DCOMMAND(objecthandle,@ADDNORMAL,0,0,1)
FOR point=0 TO pointsinline-2
faceinfo=4,vertex0[point],topfacenormal,vertex1[point],topfacenormal,vertex1[point+1],topfacenormal,vertex0[point+1],topfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
NEXT point
'Create bottom faces
bottomfacenormal=D3DCOMMAND(objecthandle,@ADDNORMAL,0,0,-1)
FOR point=0 TO pointsinline-2
faceinfo=4,vertex2[point],bottomfacenormal,vertex3[point],bottomfacenormal,vertex3[point+1],bottomfacenormal,vertex2[point+1],bottomfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
NEXT point
'Create side faces
FOR point=0 TO pointsinline-2
IF linesegmentangledifference[point]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[point]),-SIN(linesegmentangle[point]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[point]),-SIN(pointangle[point]),0)
ENDIF
IF linesegmentangledifference[point+1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[point]),-SIN(linesegmentangle[point]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[point+1]),-SIN(pointangle[point+1]),0)
ENDIF
faceinfo=4,vertex3[point],normal1,vertex0[point],normal1,vertex0[point+1],normal2,vertex3[point+1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
IF linesegmentangledifference[point]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[point]),SIN(linesegmentangle[point]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[point]),SIN(pointangle[point]),0)
ENDIF
IF linesegmentangledifference[point+1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[point]),SIN(linesegmentangle[point]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[point+1]),SIN(pointangle[point+1]),0)
ENDIF
faceinfo=4,vertex1[point],normal1,vertex2[point],normal1,vertex2[point+1],normal2,vertex1[point+1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
NEXT point
'Add end faces/close object
IF lineclosed[linenumber]
'Close object
'Top face
faceinfo=4,vertex1[0],topfacenormal,vertex0[0],topfacenormal,vertex0[pointsinline-1],topfacenormal,vertex1[pointsinline-1],topfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
'Bottom face
faceinfo=4,vertex3[0],bottomfacenormal,vertex2[0],bottomfacenormal,vertex2[pointsinline-1],bottomfacenormal,vertex3[pointsinline-1],bottomfacenormal
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
'Side faces
IF linesegmentangledifference[0]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[pointsinline-2]),-SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[0]),-SIN(pointangle[0]),0)
ENDIF
IF linesegmentangledifference[pointsinline-1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(linesegmentangle[pointsinline-2]),-SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,-COS(pointangle[pointsinline-1]),-SIN(pointangle[pointsinline-1]),0)
ENDIF
faceinfo=4,vertex0[0],normal1,vertex3[0],normal1,vertex3[pointsinline-1],normal2,vertex0[pointsinline-1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
IF linesegmentangledifference[0]>1.571/2
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[pointsinline-2]),SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal1=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[0]),SIN(pointangle[0]),0)
ENDIF
IF linesegmentangledifference[pointsinline-1]>1.571/2
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(linesegmentangle[pointsinline-2]),SIN(linesegmentangle[pointsinline-2]),0)
ELSE
normal2=D3DCOMMAND (objecthandle,@ADDNORMAL,COS(pointangle[pointsinline-1]),SIN(pointangle[pointsinline-1]),0)
ENDIF
faceinfo=4,vertex2[0],normal1,vertex1[0],normal1,vertex1[pointsinline-1],normal2,vertex2[pointsinline-1],normal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
ELSE
'Add endfaces
endfacenormal1=D3DCOMMAND (objecthandle,@ADDNORMAL,-SIN(linesegmentangle[0]),-COS(linesegmentangle[0]),0)
faceinfo=4,vertex3[0],endfacenormal1,vertex2[0],endfacenormal1,vertex1[0],endfacenormal1,vertex0[0],endfacenormal1
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
endfacenormal2=D3DCOMMAND (objecthandle,@ADDNORMAL,SIN(linesegmentangle[pointsinline-2]),COS(linesegmentangle[pointsinline-2]),0)
faceinfo=4,vertex0[pointsinline-1],endfacenormal2,vertex1[pointsinline-1],endfacenormal2,vertex2[pointsinline-1],endfacenormal2,vertex3[pointsinline-1],endfacenormal2
D3DCOMMAND(objecthandle,@ADDFACES,faceinfo)
ENDIF
pointsused=pointsused+pointsinline
NEXT linenumber
D3DCOMMAND objecthandle,@CUSTOMINIT
RETURN objecthandle
SUB lineangle(x1,y1,x2,y2)
DEF angle:FLOAT
DEF dx,dy:INT
dx=x2-x1:dy=y2-y1
IF dy=0
IF dx<0
angle=3.124+1.571
ELSE
angle=1.571
ENDIF
ELSE
angle=ATAN(dx/dy)
IF dy<0 THEN angle=3.142+angle
IF angle<0 THEN angle=6.283+angle
ENDIF
RETURN angle
SUB setcontrols
IF numberofpointsinline[selectedline]=3
ENABLECONTROL win,closeoropenlinebutton,1
SETCONTROLTEXT win,closeoropenlinebutton,"Close line"
'Enable save options on file menu
ENABLEMENUITEM win,2,1
ENABLEMENUITEM win,3,1
ENDIF
IF numberofpointsinline[selectedline]=2
ENABLECONTROL win,threeDpreviewbutton,1
ENDIF
IF numberofpointsinline[selectedline]=1
ENABLECONTROL win,editpointsradiobutton,1
ENDIF
RETURN
SUB deletelineswithonepoint
DEF newnumberoflines:INT
newnumberoflines=numberoflines
FOR numberofline=0 TO numberoflines-1
IF numberofpointsinline[numberofline]<2
'Delete line
IF numberofline<>numberoflines-1
'Move point array data up
FOR linenumber=numberofline TO numberoflines-2
pointsinline=numberofpointsinline[linenumber+1]
FOR point=0 TO pointsinline-1
pointx[point,linenumber]=pointx[point,linenumber+1]
pointy[point,linenumber]=pointx[point,linenumber+1]
NEXT point
NEXT linenumber
ENDIF
newnumberoflines=newnumberoflines-1
ENDIF
NEXT numberofline
numberoflines=newnumberoflines
selectedpoint=-1:selectedline=-1
RECT win,drawingarealeft,0,drawingareasize,drawingareasize,0,0
GOSUB redrawlines
RETURN
SUB mousemovehandler
IF GETKEYSTATE(1) & GETKEYSTATE(1)
'Left mouse button down
IF mode=addlines
'In add lines mode
IF lineclosed[selectedline]=0 & numberofpointsinline[selectedline]<maxnumberofpointsperline
'The selected line is open and has fewer than the maximum number of points
IF ABS(@MOUSEX-pointx[selectedpoint,selectedline])+ABS(@MOUSEY-pointy[selectedpoint,selectedline])>5*(xmult+ymult)/2.0
'Mouse is not too close to selected point
addnewpoint=1
IF numberofpointsinline[selectedline]>1
'Only add new point if not close to selected point and not in line with it and point before
'Find distance from selected point to one before it
xdiff=pointx[selectedpoint,selectedline]-pointx[selectedpoint-1,selectedline]
ydiff=pointy[selectedpoint,selectedline]-pointy[selectedpoint-1,selectedline]
distance1=SQRT(xdiff*xdiff+ydiff*ydiff)
'Find distance from mouse position to selected point
xdiff=pointx[selectedpoint,selectedline]-@MOUSEX
ydiff=pointy[selectedpoint,selectedline]-@MOUSEY
distance2=SQRT(xdiff*xdiff+ydiff*ydiff)
'Find distance from mouse position to point before selected one
xdiff=pointx[selectedpoint-1,selectedline]-@MOUSEX
ydiff=pointy[selectedpoint-1,selectedline]-@MOUSEY
distance3=SQRT(xdiff*xdiff+ydiff*ydiff)
IF (distance1+distance2)<((1.3-distance2/(40*xmult))*distance3)
'Don't add new point
addnewpoint=0
ENDIF
ENDIF
IF addnewpoint
'Add new point
pointx[selectedpoint+1,selectedline]=@MOUSEX
pointy[selectedpoint+1,selectedline]=@MOUSEY
numberofpointsinline[selectedline]=numberofpointsinline[selectedline]+1
selectedpoint=numberofpointsinline[selectedline]-1
'Erase rectangle for previously selected point
RECT win,pointx[selectedpoint-1,selectedline]-2*xmult,pointy[selectedpoint-1,selectedline]-2*ymult,4*xmult,4*ymult,0,0
IF numberofpointsinline[selectedline]<4 THEN GOSUB setcontrols
GOSUB redrawlines
ENDIF
ENDIF
ENDIF
ELSE
'In edit points mode
'Erase rectangle and lines for point moved
RECT win,pointx[selectedpoint,selectedline]-2*xmult,pointy[selectedpoint,selectedline]-2*ymult,4*xmult,4*ymult,0,0
IF selectedpoint<>0
'Point selected is not first point in line
Ha .. :) I think you've exceeded some code limit somewhere .. I think it's truncated the listing ..
Graham
Zip it an attach it.
It's done ;)