' 2D Vewctor Object desinger. ' Looks a bit odd as ripped from another in-game designer. ' ' Copyright 2005 Ian Cowburn ' ' $Id$ ' Strict Import noddybox.vectorgfx Import noddybox.bitmapfont Import noddybox.simplegui ' Included binaries ' Incbin "font.bmf" Incbin "pointer.png" ' Initialise ' SeedRnd(MilliSecs()) SetGraphicsDriver GLMax2DDriver() Graphics 800,600 HideMouse SetBlend(ALPHABLEND) SetAlpha(1.0) ' Globals ' Global font:TBitmapFont=TBitmapFont.Load("incbin::font.bmf",0) Global pointer:TImage=LoadImage("incbin::pointer.png",0) TGUIFont.font=font Global quit:Int=False Global filename:String="default.vec2d" Global scale:Double=1.0 ' **** Main ' If AppArgs.length>1 DoDesigner(AppArgs[1]) Else DoDesigner(Null) EndIf EndGraphics End ' **** Types ' Type TDesObj Abstract Field selsize:Int Function LoadFromObject:TDesObj(o:Object) Abstract Method CreateForObject:Object() Abstract Method Draw(normals:Int) Abstract Method DrawSelect() Abstract Method MouseOver:Int(x:Int, y:Int) Abstract Method Drag(x:Int, y:Int, show:Int) Abstract Method Edit() Abstract Method SetInfo(w:TLabel) Abstract Method Snap() Abstract Method DrawSelBox(x:Double, y:Double) Local x1:Int=x*scale-selsize Local y1:Int=y*scale-selsize Local x2:Int=x*scale+selsize Local y2:Int=y*scale+selsize SetColor(255,255,255) DrawLine(x1,y1,x2,y1) DrawLine(x2,y1,x2,y2) DrawLine(x2,y2,x1,y2) DrawLine(x1,y2,x1,y1) End Method Method InSelBox(px:Double, py:Double, x:Double, y:Double) Local x1:Int=x*scale-selsize Local y1:Int=y*scale-selsize Local x2:Int=x*scale+selsize Local y2:Int=y*scale+selsize Return px>=x1 And px<=x2 And py>=y1 And py<=y2 End Method Method DrawCoord(x:Int, y:Int) font.Draw(x+","+y,0,0) End Method Method DrawCoords(x1:Int, y1:Int, x2:Int, y2:Int) font.Draw(x1+","+y1+" -> "+x2+","+y2,0,0) End Method Method DoubleString:String(v:Double) Local s:String=v If s.Find(".")<>-1 While s.length>1 And s[s.length-1]=Asc("0") s=s[..s.length-1] Wend While s.length>1 And s[s.length-1]=Asc(".") s=s[..s.length-1] Wend EndIf Return s End Method Method BoolString:String(b:Int) If b Return "Yes" Else Return "No " EndIf End Method Method CalcSnap:Int(p:Int) Return (p+(Designer.GRID/2*Sgn(p)))/Designer.GRID*Designer.GRID End Method End Type Type TDesLine Extends TDesObj Field p1:TDesPoint Field p2:TDesPoint Field r:Int Field g:Int Field b:Int Field id:Int Function Create:TDesLine(p1:TDesPoint,p2:TDesPoint) Local o:TDesLine=New TDesLine o.p1=p1 o.p2=p2 o.r=255 o.g=255 o.b=255 o.selsize=3 Return o End Function Function LoadFromObject:TDesObj(o:Object) Local lp:TVectorGfxLine=TVectorGfxLine(o) Local no:TDesLine=New TDesLine no.p1=FindPoint(lp.i1) no.p2=FindPoint(lp.i2) no.r=lp.r no.g=lp.g no.b=lp.b no.id=lp.id no.selsize=3 Return no End Function Method CreateForObject:Object() Return TVectorGfxLine.Create(FindPointIndex(p1),FindPointIndex(p2),r,g,b,id) End Method Method CX:Double() Return p1.x+(p2.x-p1.x)/2.0 End Method Method CY:Double() Return p1.y+(p2.y-p1.y)/2.0 End Method Method Draw(normals:Int) If normals Local v:TVector=TVector.Create(p2.y-p1.y,p1.x-p2.x) v.Normalise() SetColor(r/2,g/2,b/2) DrawLine(CX()*scale,CY()*scale,CX()*scale+v.x*10,CY()*scale+v.y*10) EndIf SetColor(r,g,b) DrawLine(p1.lx()*scale,p1.ly()*scale,p2.lx()*scale,p2.ly()*scale) End Method Method DrawSelect() DrawSelBox(CX(),CY()) End Method Method MouseOver:Int(x:Int, y:Int) Return InSelBox(x,y,CX(),CY()) End Method Method Drag(x:Int, y:Int, show:Int) x:-CX() y:-CY() p1.x:+x p2.x:+x p1.y:+y p2.y:+y If show DrawCoords(p1.x,p1.y,p2.x,p2.y) EndIf End Method Method Edit() Designer.ld_red.text = r Designer.ld_green.text = g Designer.ld_blue.text = b Designer.ld_id.text = id If GUIDialog(Designer.ldialog,Designer.ld_ok,Designer.ld_cancel,pointer) r = Min(255,Designer.ld_red.text.ToInt()) g = Min(255,Designer.ld_green.text.ToInt()) b = Min(255,Designer.ld_blue.text.ToInt()) id = Designer.ld_id.text.ToInt() EndIf End Method Method SetInfo(w:TLabel) w.text=p1.x+","+p1.y+" -> "+p2.x+","+p2.y+" ID:"+id EndMethod Method Snap() p1.x=CalcSnap(p1.x) p1.y=CalcSnap(p1.y) p2.x=CalcSnap(p2.x) p2.y=CalcSnap(p2.y) End Method Method FlipNormal() Local t:TDesPoint=p1 p1=p2 p2=t End Method End Type Type TDesPoint Extends TDesObj Field x:Int Field y:Int Field dx:Double Field dy:Double Function Create:TDesObj(x:Int, y:Int) Local o:TDesPoint=New TDesPoint o.x=x o.y=y o.selsize=3 Return o End Function Function LoadFromObject:TDesObj(o:Object) Local lp:TVectorGfxPoint=TVectorGfxPoint(o) Local no:TDesPoint=New TDesPoint no.x=lp.x no.y=lp.y no.selsize=3 Return no End Function Method CreateForObject:Object() Return TVectorGfxPoint.Create(x,y) End Method Method Draw(normals:Int) SetColor(255,255,255) DrawRect(lx()*scale-1,ly()*scale-1,3,3) End Method Method DrawSelect() DrawSelBox(lx(),ly()) End Method Method MouseOver:Int(x:Int, y:Int) Return InSelBox(x,y,self.x,self.y) End Method Method Drag(x:Int, y:Int, show:Int) self.x=x self.y=y If show DrawCoord(x,y) EndIf End Method Method DragDelta(x:Double, y:Double) dx=x dy=y End Method Method CompleteDragDelta() x=lx() y=ly() dx=0 dy=0 End Method Method Edit() End Method Method SetInfo(w:TLabel) w.text=x+","+y EndMethod Method Snap() x=CalcSnap(x) y=CalcSnap(y) End Method Method lx:Int() Return x+dx End Method Method ly:Int() Return y+dy End Method End Type ' **** Globals ' ' This type acts as a namespace for global variables ' Type Designer Global GRID:Int=5 Global init:Int=False Global obj:TList Global gfx:TVectorGfxObject Global done:Int Global gui:TGUIHandler Global fname_txt:TLabel Global fname_load:TButton Global fname_save:TButton Global fname_new:TButton Global scale_number:TNumberInt Global grid_number:TNumberInt Global info:TLabel Global grid_check:TCheckbox Global normal_check:TCheckbox Global quitbut:TButton Global ldialog:TGUIHandler Global ld_red:TText Global ld_green:TText Global ld_blue:TText Global ld_id:TText Global ld_ok:TButton Global ld_cancel:TButton Function Initialise() If Not init Local l:TLabel Local p:TPanel obj = CreateList() gfx = New TVectorGfxObject gui = TGUIHandler.Create() fname_txt = TLabel.Create(gui,0,0,filename) fname_load = TButton.Create(gui,0,15,50,17,"Load",LoadCallback) fname_save = TButton.Create(gui,fname_load.x+fname_load.w+10,15,50,fname_load.h,"Save",SaveCallback) fname_new = TButton.Create(gui,fname_save.x+fname_save.w+10,15,50,fname_load.h,"New",NewCallback) TLabel.Create(gui,0,40,"Scale") scale_number = TNumberInt.Create(gui,70,40,ScaleCallback) scale_number.value=scale scale_number.minval=1 scale_number.maxval=10 scale_number.change=1 TLabel.Create(gui,150,40,"Grid size") grid_number = TNumberInt.Create(gui,220,40,GridSizeCallback) grid_number.value=GRID grid_number.minval=2 grid_number.maxval=10 grid_number.change=1 info = TLabel.Create(gui,0,50,"") grid_check = TCheckbox.Create(gui,740,0,"Grid") normal_check = TCheckbox.Create(gui,740,15,"Normals") grid_check.checked= True quitbut = TButton.Create(gui,750,570,49,29,"Quit",QuitCallback) ldialog = TGUIHandler.Create() p = TPanel.Create(ldialog,-1,-1,400,150) l = TLabel.Create(ldialog,p.x+5,p.y+10,"Red:") ld_red = TText.Create(ldialog,l.x+l.w+10,l.y,"",3,TText.NUMERIC|TText.INTEGER|TText.POSITIVE) l = TLabel.Create(ldialog,p.x+5,p.y+30,"Green:") ld_green = TText.Create(ldialog,l.x+l.w+10,l.y,"",3,TText.NUMERIC|TText.INTEGER|TText.POSITIVE) l = TLabel.Create(ldialog,p.x+5,p.y+50,"Blue:") ld_blue = TText.Create(ldialog,l.x+l.w+10,l.y,"",3,TText.NUMERIC|TText.INTEGER|TText.POSITIVE) l = TLabel.Create(ldialog,p.x+5,p.y+70,"Collision ID:") ld_id = TText.Create(ldialog,l.x+l.w+10,l.y,"",30,TText.NUMERIC|TText.INTEGER|TText.POSITIVE) ld_ok = TButton.Create(ldialog,p.x+5,p.y+p.h-25,p.w/2-10,20,"OK",Null) ld_cancel = TButton.Create(ldialog,p.x+p.w/2+5,p.y+p.h-25,p.w/2-10,20,"Cancel",Null) init=True EndIf done = False LoadObject() End Function Function SaveObject() Local lines:TList=CreateList() Local points:TList=CreateList() For Local d:TDesObj=EachIn obj If IsPoint(d) points.AddLast(d.CreateForObject()) Else lines.AddLast(d.CreateForObject()) EndIf Next gfx.SetPoints(points.ToArray()) gfx.SetLines(lines.ToArray()) End Function Function LoadObject() obj.Clear() For Local p:TVectorGfxPoint=EachIn gfx.points obj.AddLast(TDesPoint.LoadFromObject(p)) Next For Local l:TVectorGfxLine=EachIn gfx.lines obj.AddLast(TDesLine.LoadFromObject(l)) Next End Function End Type ' **** Main Loop ' Function DoDesigner(loadfile:String) Designer.Initialise() If loadfile Local o:TVectorGfxObject=TVectorGfxObject.Load(loadfile) If o<>Null filename=loadfile Designer.fname_txt.text=filename Designer.gfx=o Designer.gfx.x=0 Designer.gfx.y=0 Designer.gfx.ang=0 Designer.LoadObject() Else GUINotify("Failed to load '" + Designer.fname_txt.text + "'",pointer) EndIf EndIf Designer.done=False Const NORMAL_MODE:Int=0 Const LINE_MODE:Int=1 Const DOT_TO_DOT_MODE:Int=2 Const DOT_TO_DOT_SNAP_MODE:Int=3 Const LINE_TO_LINE_MODE:Int=4 Const DRAG_NONE:Int=0 Const DRAG_SINGLE:Int=1 Const DRAG_MULTI:Int=2 Local sel:TDesObj=Null Local drag:Int=DRAG_NONE Local sellist:TList=CreateList() Local mode:Int=NORMAL_MODE Local dragx:Double Local dragy:Double While Not Designer.done Cls ' **** START CENTRED ' SetOrigin(GraphicsWidth()/2,GraphicsHeight()/2) If Designer.grid_check.checked SetAlpha(0.7) Local x:Int=0 While x>-400 x:-Designer.GRID Wend While x<=400 If x=0 SetColor(50,50,255) Else SetColor(50,50,128) EndIf DrawLine(x*scale,-300,x*scale,300) x:+Designer.GRID Wend Local y:Int=0 While y>-300 y:-Designer.GRID Wend While y<=300 If y=0 SetColor(50,50,255) Else SetColor(50,50,128) EndIf DrawLine(-400,y*scale,400,y*scale) y:+Designer.GRID Wend SetAlpha(1) EndIf Local x:Int=(MouseX()-GraphicsWidth()/2) Local y:Int=(MouseY()-GraphicsHeight()/2) If drag=DRAG_NONE sel=Null EndIf For Local o:TDesObj=EachIn Designer.obj o.Draw(Designer.normal_check.checked) If sel=Null And o.MouseOver(x,y) sel=o EndIf Next If sel<>Null sel.SetInfo(Designer.info) Select mode Case LINE_MODE If IsPoint(sel) If sellist.Count()=0 sellist.AddLast(sel) Else If sel<>sellist.ValueAtIndex(0) mode=NORMAL_MODE Designer.obj.AddLast(TDesLine.Create(TDesPoint(sellist.ValueAtIndex(0)),TDesPoint(sel))) sellist.Clear() EndIf EndIf EndIf Case LINE_TO_LINE_MODE If IsPoint(sel) If sellist.Count()=0 sellist.AddLast(sel) Else If sel<>sellist.ValueAtIndex(0) Designer.obj.AddLast(TDesLine.Create(TDesPoint(sellist.ValueAtIndex(0)),TDesPoint(sel))) sellist.Clear() EndIf EndIf EndIf Case NORMAL_MODE If KeyDown(KEY_LSHIFT) Or KeyDown(KEY_RSHIFT) If IsPoint(sel) And Not sellist.Contains(sel) sellist.AddLast(sel) EndIf Else sellist.Clear() sellist.AddLast(sel) EndIf End Select Else If Not KeyDown(KEY_LSHIFT) And Not KeyDown(KEY_RSHIFT) sellist.Clear() EndIf EndIf For Local o:TDesObj=EachIn sellist o.DrawSelect() Next If drag=DRAG_SINGLE sel.Drag(x/scale,y/scale,True) ElseIf drag=DRAG_MULTI For Local o:TDesPoint=EachIn sellist o.DragDelta((x-dragx)/scale,(y-dragy)/scale) Next EndIf SetOrigin(0,0) ' ' **** END CENTRED If drag=DRAG_NONE And mode=NORMAL_MODE Designer.gui.EventLoop() EndIf If mode=NORMAL_MODE And KeyHit(KEY_MOUSERIGHT) If sellist.Count()>0 Select GUIMenu("Point Menu",["Snap to grid","Delete"],MouseX(),MouseY(),pointer) Case 0 For Local o:TDesPoint=EachIn sellist o.Snap() Next sellist.Clear() Case 1 For Local o:TDesPoint=EachIn sellist Designer.obj.Remove(o) For Local d:TDesLine=EachIn Designer.obj If d<>Null And (d.p1=o Or d.p2=o) Designer.obj.Remove(d) EndIf Next Next sellist.Clear() EndSelect Else If sel<>Null If IsPoint(sel) Select GUIMenu("Point Menu",["Snap to grid","Delete"],MouseX(),MouseY(),pointer) Case 0 sel.Snap() Case 1 Designer.obj.Remove(sel) For Local d:TDesLine=EachIn Designer.obj If d<>Null And (d.p1=sel Or d.p2=sel) Designer.obj.Remove(d) EndIf Next End Select Else Local l:TDesLine=TDesLine(sel) Select GUIMenu("Line Menu",["Edit","Snap to grid","Flip","Delete"],MouseX(),MouseY(),pointer) Case 0 l.Edit() Case 1 l.Snap() Case 2 l.FlipNormal() Case 3 Designer.obj.Remove(l) End Select EndIf Else Select GUIMenu("Create Menu",["Create Point","Create Line","Create Points","Create Points (Snapped)","Create Lines"],MouseX(),MouseY(),pointer) Case 0 Designer.obj.AddLast(TDesPoint.Create(x/scale,y/scale)) Case 1 sellist.Clear() sel=Null mode=LINE_MODE Case 2 sellist.Clear() sel=Null mode=DOT_TO_DOT_MODE Case 3 sellist.Clear() sel=Null mode=DOT_TO_DOT_SNAP_MODE Case 4 sellist.Clear() sel=Null mode=LINE_TO_LINE_MODE End Select EndIf sel=Null EndIf EndIf SetColor(255,255,255) Select mode Case NORMAL_MODE If drag=DRAG_NONE If KeyDown(KEY_MOUSELEFT) If sel<>Null And Not KeyDown(KEY_LSHIFT) And Not KeyDown(KEY_RSHIFT) drag=DRAG_SINGLE ElseIf (KeyDown(KEY_LSHIFT) Or KeyDown(KEY_RSHIFT)) And sellist.Count()>0 drag=DRAG_MULTI dragx=x dragy=y EndIf EndIf Else If Not KeyDown(KEY_MOUSELEFT) If drag=DRAG_MULTI For Local o:TDesPoint=EachIn sellist o.CompleteDragDelta() Next EndIf drag=DRAG_NONE EndIf EndIf Case LINE_MODE If sellist.Count()=0 Tip("Move to first point") Else Tip("Move to second point") EndIf Case DOT_TO_DOT_MODE Tip("Press Button to place") If KeyHit(KEY_MOUSELEFT) Local p:TDesPoint=TDesPoint(TDesPoint.Create(x/scale,y/scale)) Designer.obj.AddLast(p) EndIf Case DOT_TO_DOT_SNAP_MODE Tip("Press Button to place") If KeyHit(KEY_MOUSELEFT) Local p:TDesPoint=TDesPoint(TDesPoint.Create(x/scale,y/scale)) p.Snap() Designer.obj.AddLast(p) EndIf Case LINE_TO_LINE_MODE If sellist.Count()=0 Tip("Move to first point") Else Tip("Move to next point") EndIf End Select If KeyHit(KEY_ESCAPE) mode=NORMAL_MODE FlushKeys() EndIf DrawImage(pointer,MouseX(),MouseY()) Flip FlushMem Wend End Function Function Tip(s:String) font.Draw(s+" [ESC to cancel]",MouseX()+12,MouseY()+12) End Function Function IsLine:Int(o:Object) Local p:TDesLine=TDesLine(o) Return p<>Null End Function Function IsPoint:Int(o:Object) Local p:TDesPoint=TDesPoint(o) Return p<>Null End Function Function FindPoint:TDesPoint(i:Int) For Local o:Object=EachIn Designer.obj If IsPoint(o) If i=0 Return TDesPoint(o) EndIf i:-1 EndIf Next Return Null End Function Function FindPointIndex:Int(p:TDesPoint) Local i:Int=0 For Local o:Object=EachIn Designer.obj If IsPoint(o) If o=p Return i EndIf i:+1 EndIf Next Return 0 End Function ' **** Callbacks ' Function QuitCallback(w:TWidget) Designer.done=GUIYesNo("Quit?",pointer) End Function Function LoadCallback(w:TWidget) Local fn:String=GUIFileSelect("Select object to load",filename,False,pointer) If fn<>Null Local o:TVectorGfxObject=TVectorGfxObject.Load(fn) If o<>Null filename=fn Designer.fname_txt.text=filename Designer.gfx=o Designer.gfx.x=0 Designer.gfx.y=0 Designer.gfx.ang=0 Designer.LoadObject() Else GUINotify("Failed to load '" + Designer.fname_txt.text + "'",pointer) EndIf EndIf End Function Function SaveCallback(w:TWidget) Local fn:String=GUIFileSelect("Select object to save",filename,True,pointer) If fn<>Null filename=fn Designer.fname_txt.text=filename Designer.SaveObject() Designer.gfx.Save(filename) EndIf End Function Function NewCallback(w:TWidget) If GUIYesNo("Lose current object?",pointer) Designer.gfx=New TVectorGfxObject Designer.LoadObject() EndIf End Function Function ScaleCallback(w:TWidget) Local c:TNumberInt=TNumberInt(w) scale=c.value End Function Function GridSizeCallback(w:TWidget) Local c:TNumberInt=TNumberInt(w) Designer.GRID=c.value End Function