3D 'Line extrusion editor by jolly Roger

[pistol350]

Edit : zip file attached.

My godnes!!!!!!
incredible!!
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
   

[GWS]

Ha ..   I think you've exceeded some code limit somewhere .. I think it's truncated the listing ..

Graham

[Ionic Wind Support Team]

Zip it an attach it.

[pistol350]

It's done