Main Menu

Polygon Track Editor

Started by kevin, March 02, 2014, 08:07:38 AM

Previous topic - Next topic

kevin

  Polygon Track Editor

    This is a bare bones race track creation tool from line segments.  The tool lets the user position and append new segments to an existing chain.  This chain is drawn as a set of quad polygons to make the track.

 
  Controls:

   * Mouse Position Segment
   * Mouse Wheel Rotate/Turn segment
   * A= Add current segment to the end of the existing list
   * D= delete (mouse has to be over center point of segment in track)
   * I = insert behind the current highlighted point


PlayBASIC Code: [Select]
   MakeBitmapFont 1,-1,8

Type tPolyLine
x1#,y1# ; left edge of track
x2#,y2# ; right edge of trac
EndTYpe

Dim TRack(0) as tPolyLine

radius=60
angle#=0

; --------------------------------------------------------------------------
Do ;--------------------------->> Main Loop <<-----------------------------
; --------------------------------------------------------------------------

cls


CurrentTime=Timer()
Mx =MouseX()
My =MouseY()
Mz =Mousemovez()

if Mz<>0
angle#=wrapangle(angle#+(mz*5))
endif

DrawTrack(mx,my)


Show_Cursor(mx,my,angle#,radius)

ThisKey$ =INkey$()

if Keystate(211) then ThisKey$="d"

; -----------------------------------------------------------
Select lower$(ThisKey$)

; -----------------------------------------------------------
case "a" ; ADD point end track
; -----------------------------------------------------------
AddPointToTrack(mx,my,angle#,Radius)
flushkeys

; -----------------------------------------------------------
case "i" ; insert point
; -----------------------------------------------------------

InsertPointIntoTrack(mx,my,angle#,Radius)
flushkeys

; -----------------------------------------------------------
case "d" ; delete the segment the mouse is over
; -----------------------------------------------------------

DeletePointFromTrack(mx,my)
flushkeys

EndSelect

Info_Blurb(10,10)

Sync
loop esckey()=true



; --------------------------------------------------------------------------
; --------------------------------------------------------------------------
; --------------------------------------------------------------------------
; ------------------------->> FUnctions <<-----------------------------
; --------------------------------------------------------------------------
; --------------------------------------------------------------------------
; --------------------------------------------------------------------------

Psub Show_Cursor(mx,my,angle#,radius)

x1#,y1#,x2#,y2#=Compute_track_edges(mx,my,angle#,Radius)

linec x1#,y1#,x2#,y2#,$ff0000
circlec x1#,y1#,5,true,$0000ff
circlec mx,my,5,true,$0000ff

EndPsub


Psub Compute_track_edges(x,y,angle#,Radius)

angle2#=wrapangle(angle#-180)

x1#=x+cos(angle2#)*RAdius
y1#=y+sin(angle2#)*RAdius
x2#=x+cos(angle#)*RAdius
y2#=y+sin(angle#)*RAdius

EndPsub x1#,y1#,x2#,y2#


Psub Info_Blurb(xpos,ypos)
Th=GetTextHeight("|")
text xpos,ypos,"Track Size:"+Str$(GetTRackSize()): ypos+=Th
text xpos,ypos,"Fps:"+Str$(fps()): ypos+=Th
EndPsub


Psub GetTRackSize()
size=GetArrayElements(Track())
EndPsub Size




Function DrawTrack(Mx,My)

size =GetTRackSize()

if Size>0
TrackColour = $30ff40

Xpos=GetSCreenWidth()-100

lockbuffer
for lp =1 to Size-1

Index=lp
NextIndex=LP+1
if NextIndex>Size then NextIndex=1

if Index <> NextINdex

text Xpos,lp*20, str$(Index) + " to " +Str$(NextIndex)

; current point
x1=TRack(Index).x1
y1=TRack(Index).y1

; next point
x2=TRack(nextIndex).x1
y2=TRack(nextIndex).y1

x3=TRack(nextIndex).x2
y3=TRack(nextIndex).y2

x4=TRack(Index).x2
y4=TRack(Index).y2

Login required to view complete source code

monkeybot

#1
hmm that's nice.it would make it much easier to implement computer racers than the method i am using.