Sorry your browser is not supported!

sync on
sync rate  100
set text font "Fixedsys",1
font$="Fixedsys"
set text size 20
global dim folder$(600)
global dropdown
global t
global replace
global add
global cut
global coppy
global fontnumber
global keypress$
global menuscroll
global font$
fontnumber=1
global paste
global scroll3
add=3
wrap=15
cls
color backdrop rgb(100,100,100)
dim letter$(100000)
dim letter2$(100000,1)
dim hilighting(100000)
dim coppy$(1000)
syn=1
set image colorkey 255,0,255
ink rgb(255,0,255),rgb(255,0,255)
box 0,0,10,20
ink 0,0
line 5,0,5,20
line 0,0,10,0
line 0,20,10,20
get image 1,0,0,10,21
gosub fontfacing
backspace=200
keypress$=""
lastchar=(screen width()-400)/text width("a")
oldcursor=0
cursor=0
set window size 800,600
do
   gosub autosave
   main:
   scroll2=mousemovez()/120
   spacebar=spacekey()
   backkey=keystate(14)
   theight=text height("a")
   scroll=scroll+scroll2*theight+scroll3*theight
   cursor=cursor-lastchar*(scroll3+scroll2)
   if cursor>i
      for j=i to cursor
          letter$(j)=" "
      next j
      i=cursor
   endif
   scroll3=0
   if scroll>0 then scroll=0
   twidth=text width("a")
   lastrow=scroll+650
   keypress$=entry$()
   clear entry buffer
   if asc(keypress$)>32 and spacebar=1 then goto nocheck
   write:
   if keypress$=key$
      if keypress$=""
      else
         held=held+1
         if held>750
            letter$(cursor)=letter$(cursor)+keypress$
            wait 5
            i=i+1
            cursor=cursor+1
            oldcursor=cursor
            if cursor<i
               for j=i to cursor step -1
                  letter$(j+1)=letter$(j)
               next j
            endif
         endif
      endif
   else
      held=0
      a=asc(keypress$)
      if a>32
         if cursor<i
            for j=i to cursor step -1
               letter$(j+1)=letter$(j)
            next j
         endif
         letter$(cursor)=keypress$
         i=i+1
         cursor=cursor+1
         oldcursor=cursor
      endif
   endif
   nocheck:
   if asc(keypress$)>32
      key$=keypress$
   else
      key$=""
   endif
   if spacebar=1 then key$=" "
   if spacebar=1 and spaceagain=0
      if i>cursor
         for j=i to cursor step -1
               letter$(j+1)=letter$(j)
         next j
         spaceagain=1
         letter$(cursor)=" "
         i=i+1
         cursor=cursor+1
         oldcursor=cursor
      else
         spaceagain=1
         letter$(cursor)=" "
         i=i+1
         cursor=cursor+1
         oldcursor=cursor
      endif
   endif
   if spacebar=0 then spaceagain=0
   if returnkey()=1
      row=cursor/lastchar
      newcursor=(row+1)*lastchar
      differencecursor=newcursor-cursor
      cursor=newcursor
      oldcursor=cursor
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      else
         i=i+differencecursor
      endif
      wait 200
   endif
   if cursorchange>0
      if backkey=1 and back=0 and i>0
         if cursor>oldcursor
            bakspace:
            for j=oldcursor to i
               letter$(j)=letter$(j+cursorchange)
            next j
            for j=i-cursorchange to i
               letter$(j)=""
            next j
            cursor=cursor-cursorchange
            oldcursor=cursor
            i=i-cursorchange
            if i<0 then i=0
            if cursor<0 then cursor=0
            cursorchange=0
            back=1
            wait 200
         endif
         if cursor<oldcursor
            for j=cursor to i
               letter$(j)=letter$(j+cursorchange)
            next j
            for j=i-cursorchange to i
               letter$(j)=""
            next j
            oldcursor=cursor
            i=i-cursorchange
            cursorchange=0
            back=1
            wait 200
         endif
      endif
   endif
   if backkey=1 and i>0 and cursor>0 and back=0 or backspace<1 and i>0 and cursor>0
      back=1
      i=i-1
      cursor=cursor-1
      oldcursor=cursor
      letter$(cursor)=""
      if cursor<i
         for j=cursor to i
            letter$(j)=letter$(j+1)
         next j
      endif
   endif

   if backkey=1 then backspace=backspace-1
   if backkey=0 then backspace=75:back=0
   if controlkey()=1 then ctrl=1
   if controlkey()=0 then ctrl=0
   if ctrl=1 and keystate(45)=1
   cut:
      cop=0
      if oldcursor>cursor then c1=cursor:c2=oldcursor
      if oldcursor<cursor then c2=cursor:c1=oldcursor
      clipcop$=""
      for j=c1 to c2-1
         coppy$(cop)=letter$(j)
         clipcop$=clipcop$+coppy$(cop)
         cop=cop+1
      next j
      write to clipboard clipcop$
      for j=c2 to i
         letter$(j-cop)=letter$(j)
         if j>i-cop then letter$(j)=""
      next j
      i=i-cop
      if i<0 then i=0
      cursor=cursor-cop
      if cursor<0 then cursor=0
      wait 200
   endif
   cut=0
   if ctrl=1 and keystate(46)=1
      coppy:
      cop=0
      if oldcursor>cursor then c1=cursor:c2=oldcursor
      if oldcursor<cursor then c2=cursor:c1=oldcursor
      clipcop$=""
      for j=c1 to c2-1
         coppy$(cop)=letter$(j)
         clipcop$=clipcop$+coppy$(cop)
         cop=cop+1
      next j
      write to clipboard clipcop$
      wait 200
   endif
   coppy=0
   if ctrl=1 and keystate(47)=1
   paste:
      paste$=get clipboard$()
      paste1=len(paste$)
      for j=1 to paste1
         if 32>asc(mid$(paste$,j))
            ri$=right$(paste$,paste1-j-1)
            le$=left$(paste$,j-1)
            paste$=le$+ri$
            ri$=""
            le$=""
            paste1=len(paste$)
         endif
      next j
      paste1=len(paste$)
      for j=i to cursor step -1
         letter$(j+paste1)=letter$(j)
      next j
      for j=cursor to cursor+paste1-1
         letter$(j)=mid$(paste$,j-cursor+1)
      next j
      cursor=cursor+len(paste$)
      i=i+len(paste$)
      wait 200
      paste1=0
   endif
   paste=0

   if syn=0

      cls rgb(100,100,100)
   ink rgb(255,255,255),rgb(255,255,255)
   box 100,50,700,800
      colum=colum+twidth
      wrap=wrap-1
      if wrap=0
         gosub checkforwrap
         wrap=15
      endif
      gosub movecursor
      if mouseclick()=1 then gosub checkmouse
      if mouseclick()=1
         mousehold=1
         if mouseclic>0 then mousehold=2
      else
         if mousehold=1 then mouseclic=10
         mousehold=0
      endif
      if mouseclic>0 then mouseclic=mouseclic-1
      ink 0,rgb(255,255,255)
      for j=0 to i
         column=j*twidth
         row=column/(screen width()-400)
         column=column-row*(screen width()-400)
         if row*theight+scroll>-20 and row*theight+scroll<700
            ink val(letter2$(j,1)),rgb(255,255,255)
            if hilighting(j)=1 then ink val(letter2$(j,1)),rgb(0,0,255)
            text column+200,row*theight+150+scroll,letter$(j)
            if letter2$(j,0)="1" and asc(letter$(j))>64 or letter2$(j,0)="5" and asc(letter$(j))>64 then paste image asc(letter$(j)),column+200,row*theight+150+scroll-1
            if letter2$(j,0)="2" and asc(letter$(j))>64 or letter2$(j,0)="6" and asc(letter$(j))>64 then paste image asc(letter$(j))*4,column+200,row*theight+150+scroll-1
            if letter2$(j,0)="3" and asc(letter$(j))>64 or letter2$(j,0)="7" and asc(letter$(j))>64 then paste image asc(letter$(j))*8,column+200,row*theight+150+scroll-1
            if letter2$(j,0)="4" and asc(letter$(j))>64 or letter2$(j,0)="5" or letter2$(j,0)="6" or letter2$(j,0)="7" then line column+200,row*theight+150+scroll+theight-2,column+200+twidth,row*theight+150+scroll+theight-2
            ink 0,rgb(255,255,255)
         endif
      next j
      ink rgb(200,200,200),rgb(200,200,200)
      box 0,0,800,21
      menu("FILE",200,0,250,21,1,9,0)
      menu("EDIT",250,0,300,21,2,9,0)
      menu("FONTS",650,0,800,21,3,21,0)
      menu("Special Chars.",0,0,200,21,4,200,1)
      button("/\",760,520,800,560,11)
      button("\/",760,560,800,600,12)
      button("COLOR",600,0,650,21,36)
      row2=(cursor*twidth)/(screen width()-400)
      paste image 1,(cursor*twidth)-row2*(screen width()-400)+200-(twidth/2),row2*theight+150+scroll,1
      fastsync
      cls rgb(100,100,100)
      syn=1

   endif
   if syn>0 then syn=syn-1
   if search=1 then goto insearch
loop


checkforwrap:
   for j=1 to i/lastchar
      if asc(letter$(lastchar*j))>32
         for k=lastchar*j to ((lastchar*(j-1)))+1 step -1
            if letter$(k)=" " then firstchar=k: goto checknext
         next k
         goto nowrap
         checknext:
         for k=i to firstchar step -1
            letter$((lastchar*j)-firstchar+(k)-1)=letter$(k)
         next k
         i=i+(lastchar*j)-firstchar
         if cursor=(lastchar*j) or cursor=(lastchar*j)+1 then cursor=cursor+(lastchar*j)-firstchar-1:oldcursor=cursor
         for k=firstchar to lastchar*j-1
            letter$(k)=" "
         next k
      endif
      nowrap:
   next j
return

movecursor:
   if shift=0
      if rightkey()=1  and cursor<i
         cursor=cursor+1:oldcursor=cursor:cursorchange=abs(cursor-oldcursor):wait 100
         for j=0 to i
            hilighting(j)=0
         next j
      endif
      if leftkey()=1  and cursor>0
         cursor=cursor-1:oldcursor=cursor:cursorchange=abs(cursor-oldcursor):wait 100
         for j=0 to i
            hilighting(j)=0
         next j
      endif
      if upkey()=1 and cursor>lastchar
         cursor=cursor-lastchar:wait 100
         oldcursor=cursor:cursorchange=abs(cursor-oldcursor)
         for j=0 to i
            hilighting(j)=0
         next j
      endif
      if downkey()=1 and cursor<i-lastchar+1
         cursor=cursor+lastchar:wait 100
         oldcursor=cursor:cursorchange=abs(cursor-oldcursor)
         for j=0 to i
            hilighting(j)=0
         next j
      endif
   endif
   if shiftkey()=1 and shift=1 then shift=2
   if shiftkey()=1 and shift=0 then shift=1
   if shiftkey()=0 then shift=0
   if shift=2
      for j=0 to i
          hilighting(j)=0
      next j
      if rightkey()=1  and cursor<i then cursor=cursor+1:wait 100
      if leftkey()=1  and cursor>0 then cursor=cursor-1:wait 100
      if downkey()=1 and cursor<i-lastchar+1 then cursor=cursor+lastchar:wait 100
      if upkey()=1 and cursor>lastchar then cursor=cursor-lastchar:wait 100
         if cursor<oldcursor
            for j=cursor to oldcursor-1
               hilighting(j)=1
            next j
            cursorchange=abs(cursor-oldcursor)
         endif
         if cursor>oldcursor
            for j=cursor-1 to oldcursor step -1
               hilighting(j)=1
            next j
            cursorchange=abs(cursor-oldcursor)
         endif
   endif
return

checkmouse:
   if mousey()<100 then goto nomovecursor
   if mousehold=0 or mousehold=2
      x=(mousex()-200)/twidth
      y=(mousey()-150-scroll)/theight
      if mousex()<200 or mousex()>screen width()-200 or mousey()<140 then goto nomovecursor
      cursor=y*((screen width()-400)/twidth)+x
      oldcursor=cursor
      for j=0 to i
          hilighting(j)=0
      next j
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      endif
   endif
   if mousehold=1
      for j=1 to i
          hilighting(j)=0
      next j
      x=(mousex()-200)/twidth
      y=(mousey()-150-scroll)/theight
      if mousex()<200 or mousex()>screen width()-200 or mousey()<140 then goto nomovecursor
      cursor=y*((screen width()-400)/twidth)+x
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      endif
      if cursor<oldcursor
         for j=cursor to oldcursor-1
            hilighting(j)=1
         next j
      endif
      if cursor>oldcursor
         for j=cursor-1 to oldcursor step -1
            hilighting(j)=1
         next j
      endif
   endif
   if mousehold=2
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      endif
      h=cursor
      repeat
         h=h-1
      until letter$(h)=" " or letter$(h)="" or h=0
      oldcursor=h
      repeat
         h=h+1
      until letter$(h)=" " or letter$(h)=""
      cursor=h
      for j=cursor-1 to oldcursor step -1
         hilighting(j)=1
      next j
   endif
   cursorchange=abs(cursor-oldcursor)
   nomovecursor:
return



function button(caption$,left,top,right,bottom,number)
   ink 0,rgb(200,200,200)
   if mousex()>left and mousey()>top and mousex()<right and mousey()<bottom then inside=1
   if inside=1 then ink 0,rgb(0,0,200)
   if number<40 or number>200 then center text left+(right-left)/2,top+(bottom-top)/2-10,caption$
   if number>39 and number<200 then center text left+(right-left)/2,top+(bottom-top)/2-10,chr$(val(caption$))
   if inside=1 and mouseclick()=1
      if number=1 then gosub save
      if number=2 then gosub load
      if number=3 then end
      if number=4 then goto cut
      if number=5 then goto coppy
      if number=6 then goto paste
      if number=7 then gosub bold
      if number=8 then gosub Italics
      if number=9 then gosub normal
      if number=10 then gosub underline
      if number=11 then scroll3=1:wait 100
      if number=12 then scroll3=-1:wait 100
      if number=13 then gosub export
      if number=14 then gosub prin
      if number>14 and number<36
         if number>16 and number<25 or number>31 and number<35
            fontnumber=number-13
            set text font caption$,1
            set text size 20
            gosub fontfacing
            font$=caption$
         else
            fontnumber=number-13
            set text font caption$,255
            set text size 20
            gosub fontfacing
            font$=caption$
         endif
      endif
      if number=35
         fontnumber=number-13
         set text font caption$,1
         set text size 20
         gosub fontfacing
         font$=caption$
      endif
      if number=36 then gosub collor
      if number=37 then gosub upper
      if number=38 then gosub lower
      if number=39 then gosub definition
      if number>39 and number<200
         keypress$=chr$(val(caption$))
         goto write
      endif
      if number=201 then gosub search
      if number=202 then replace=1:gosub search
      if number=203 then replace=1:gosub unifyspaces
   endif
   ink 0,rgb(255,255,255)
endfunction

function menu(caption$,left,top,right,bottom,number,numofbuttons,scroll)
   ink 0,rgb(200,200,200)
   if mousex()>left and mousey()>top and mousex()<right and mousey()<bottom and mouseclick()=1 then dropdown=number
   if dropdown=number then ink 0,rgb(0,0,200)
   center text left+(right-left)/2,top+(bottom-top)/2-10,caption$
   ink 0,rgb(255,255,255)
      if dropdown=number
         if number=1 then restore m1
         if number=2 then restore m2
         if number=3 then restore m3
         if number=4 then restore m4
         if scroll=1
            if downkey()=1 then menuscroll=menuscroll+1
            if upkey()=1 then menuscroll=menuscroll-1
         for k=1 to menuscroll
            read a$
            read b
         next k
         endif

         for i=1 to numofbuttons
         read a$
         read b
         button(a$,left,bottom*i,right,bottom*(i+1),b)
         next i
         if (numofbuttons+1)*bottom <mousey() or  mousey()<top or mousex()>right or mousex()<left then dropdown=0
      endif
      back:
endfunction

Bold:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      if letter2$(j,0)="2" then letter2$(j,0)="3"
      if letter2$(j,0)="3" then goto nextbold
      if letter2$(j,0)="4" then letter2$(j,0)="5"
      if letter2$(j,0)="5" then goto nextbold
      if letter2$(j,0)="6" then letter2$(j,0)="7"
      if letter2$(j,0)="7" then goto nextbold
      letter2$(j,0)="1"
      nextbold:
   next j
return

Italics:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      if letter2$(j,0)="1" then letter2$(j,0)="3"
      if letter2$(j,0)="3" then goto nextitalics
      if letter2$(j,0)="4" then letter2$(j,0)="6"
      if letter2$(j,0)="6" then goto nextitalics
      if letter2$(j,0)="5" then letter2$(j,0)="7"
      if letter2$(j,0)="7" then goto nextitalics
      letter2$(j,0)="2"
      nextitalics:
   next j
return

Underline:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      if letter2$(j,0)="1" then letter2$(j,0)="5"
      if letter2$(j,0)="5" then goto nextunderline
      if letter2$(j,0)="2" then letter2$(j,0)="6"
      if letter2$(j,0)="6" then goto nextunderline
      if letter2$(j,0)="3" then letter2$(j,0)="7"
      if letter2$(j,0)="7" then goto nextunderline
      letter2$(j,0)="4"
      nextunderline:
   next j
return

Unifyspaces:
   for j=0 to i
      if letter$(j)=" " then space=space+1
      if asc(letter$(j))>32 and space>1
         for h=j to i
            letter$(h-space+1)=letter$(h)
            if letter$(h-space+1)="" then letter$(h-space+1)=" "
         next h
         i=i-space+1
         space=0
      endif
      if asc(letter$(j))>32 then space=0
   next j
return

search:
   ink 0,rgb(255,255,255)
   search=1
   text 0,0,"Input the search item"
   set cursor 0,20
   input search$
   wait 250
   if replace=1
      text 0,40,"Input the replace item"
      set cursor 0,60
      input replac$
      wait 100
   endif
   clear entry buffer
   searchlength=len(search$)
   search$=lower$(search$)
   firstcharofsearch$=mid$(search$,1)
   for j=0 to i
      searchj=j
      if lower$(letter$(j))=firstcharofsearch$
         for k=2 to searchlength
            if mid$(search$,k)=lower$(letter$(j+k-1))
            else
               goto stopwordsearch
            endif
         next k
         oldcursor=j
         cursor=j+searchlength
         cursorchange=abs(cursor-oldcursor)
         for k=0 to searchlength-1
            hilighting(k+j)=1
         next k
         do
         goto main
         insearch:
         if returnkey()=1 or wordreplace=1 then wait 500:clear entry buffer:goto stopwordsearch
         if mouseclick()=1 then text 0,0,"search aborted":sync:wait 500:goto quitsearch
         if mouseclick()=2 and replace=1 then wait 250: gosub replace
         loop
         stopwordsearch:
         for k=0 to i
            hilighting(k)=0
         next k
      endif
      j=searchj
   next j
   text 0,0,"search finished"
   sync
   wait 500
   quitsearch:
   search=0
   replace=0
   cursorchange=0
   oldcursor=cursor
return

replace:
   replacelength=len(replac$)
   differencelength=searchlength-replacelength
   if differencelength<0
      for h=i to cursor step -1
         letter$(h-differencelength)=letter$(h)
      next h
   endif
   if differencelength>0
      for h=cursor to i
         letter$(h-differencelength)=letter$(h)
      next h
   endif
   for h=oldcursor to oldcursor+replacelength-1
      letter$(h)=mid$(replac$,h-oldcursor+1)
   next h
   for h=i to i-differencelength
      letter$(h)=" "
   next h
   i=i-differencelength
   goto stopwordsearch
return

Normal:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      letter2$(j,0)="0"
   next j
return

save:
   if len(save$)>0 then goto save2
   ink 0,rgb(255,255,255)
   cls
   sync
   text 0,0,"Save as: "
   input "Save as: ",save$
   clear entry buffer
   save2:
   save array save$+".spopovichtext",letter$(100000)
   letter2$(100000,1)=str$(i)
   letter2$(100000,0)=str$(cursor)
   save array save$+".spopovichformating",letter2$(100000,1)
return

load:
   ink 0,rgb(255,255,255)
   cls
   text 0,0,"Load: "
   sync
   input "Load: ",save$
   clear entry buffer
   load array save$+".spopovichtext",letter$(100000)
   load array save$+".spopovichformating",letter2$(100000,1)
   i=val(letter2$(100000,1))
   cursor=val(letter2$(100000,0))
   clear entry buffer
return

export:
   ink 0,rgb(255,255,255)
   cls
   sync
   text 0,0,"Export as: "
   input "Export as: ",save$
   open to write 1,save$+".txt"
   for j=0 to i
      line$=line$+letter$(j)
      lin=lin+1
      if lin=40
         write string 1,line$
         line$=""
         lin=0
      endif
   next j
   write string 1,line$
   close file 1
   clear entry buffer
return


upper:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      letter$(j)=upper$(letter$(j))
   next j
return

lower:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      letter$(j)=lower$(letter$(j))
   next j
return

collor:
   ink 0,rgb(255,255,255)
   sync
   repeat
   r$=r$+(inkey$())
   if keystate(14)=1 then r$=left$(r$,len(r$)-2)
   cls
   text 0,20,r$
   text 0,0,"red ammount"
   sync
   wait 100
   until returnkey()=1
   r=val(r$)
   sync
   sync
   repeat
   g$=g$+(inkey$())
   if keystate(14)=1 then g$=left$(g$,len(g$)-2)
   text 0,60,g$
   text 0,40,"green ammount"
   sync
   wait 100
   until returnkey()=1
   g=val(g$)
   sync
   repeat
   b$=b$+(inkey$())
   if keystate(14)=1 then b$=left$(b$,len(b$)-2)
   text 0,100,b$
   text 0,80,"blue ammount"
   sync
   wait 100
   until returnkey()=1
   b=val(b$)
   sync
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   color=(rgb(r,g,b))
   color$=str$(color)
   color$=right$(color$,len(color$)-1)
   for j=c1 to c2-1
      letter2$(j,1)=color$
   next j
   clear entry buffer
return

prin:
   open to write 5,"print.html"
   write string 5,"<html>"
   write string 5,"<body>"
   write string 5,"<div align="+chr$(34)+"left"+chr$(34)+">"
   write string 5,"<font size="+chr$(34)+"30"+chr$(34)+" face="+chr$(34)+font$+chr$(34)+">"
   for j=0 to i
      if letter2$(j,0)="1" and bol=0 or letter2$(j,0)="5" and bol=0 then line$=line$+"<b>":bol=1:goto notnormal
      if letter2$(j,0)="2" and ital=0 or letter2$(j,0)="6" and ital=0 then line$=line$+"<i>":ital=1:goto notnormal
      if bol=1 then line$=line$+"</b>"
      if ital=1 then line$=line$+"</i>"
      notnormal:
      line$=line$+letter$(j)
      brake=brake+1
      if brake=40 then write string 5,"<br>":brake=0:write string 5,line$:line$=""
   next j
   if bol=1 then line$=line$+"</b>"
   if ital=1 then line$=line$+"</i>"
   write string 5,"</font>"
   write string 5,"</div>"
   write string 5,"</body>"
   write string 5,"</html>"
   close file 5
   execute file "print.html","","",1
   delete file "print.html"
   bol=0
   ital=0
   brake=0
return

autosave:
   if timer()>savetime+300000 and len(save$)>0 then savetime=timer():text 0,0,"Autosaving":sync: goto save2
return

definition:
   word$=""
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      word$=word$+letter$(j)
   next j
   execute file "C:\Program Files\Internet Explorer\iexplore.exe","http://dictionary.reference.com/search?q="+word$,""
return

fontfacing:
   add=3
   cls
   ink 0,rgb(255,255,255)
   cls rgb(255,255,255)
   sync
   set text to bold
   width=text width("a")
   height=text height("A")
   for j=65 to 90
   text 0,fontnumber*20,"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   sync
   get image j,(j-65)*width,fontnumber*20,(j-64)*width,fontnumber*20+20
   next j
   cls rgb(255,255,255)
   sync
   cls rgb(255,255,255)
   text 0,fontnumber*20,"abcdefghijklmnopqrstuvwxyz"
   sync
   for j=97 to 122
   get image j,(j-97)*width,fontnumber*20,(j-96)*width,fontnumber*20+20
   next j
   ink 0,rgb(255,255,255)
   set text to italic
   ink 0,rgb(255,255,255)
   cls rgb(255,255,255)
   sync
   width=text width("a")
   text 0,fontnumber*20,"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   sync
   for j=65 to 90
   get image j*4,(j-65)*width+width/2-2,fontnumber*20,(j-64)*width+width/2-2,fontnumber*20+20
   next j
   cls rgb(255,255,255)
   text 0,fontnumber*20,"abcdefghijklmnopqrstuvwxyz"
   sync
   for j=97 to 122
   get image j*4,(j-97)*width+width/2-2,fontnumber*20,(j-96)*width+width/2-2,fontnumber*20+20
   next j
   ink 0,rgb(255,255,255)
   box 0,0,10,20
   set text to bolditalic
   ink 0,rgb(255,255,255)
   cls rgb(255,255,255)
   sync
   width=text width("a")
   text 0,fontnumber*20,"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   sync
   for j=65 to 90
   get image j*8,(j-65)*width+width/2-2,fontnumber*20,(j-64)*width+width/2-2,fontnumber*20+20
   next j
   cls rgb(255,255,255)
   text 0,fontnumber*20,"abcdefghijklmnopqrstuvwxyz"
   sync
   for j=97 to 122
   get image j*8,(j-97)*width+width/2-2,fontnumber*20,(j-96)*width+width/2-2,fontnumber*20+20
   next j
   ink 0,rgb(255,255,255)
   set text to normal
   set text opaque
return

m1:
data "Save",1
data "Load",2
data "Definition",39
data "Find",201
data "Replace",202
data "Unify spaces",203
data "Export",13
data "print",14
data "Exit",3
return
m2:
data "Cut",4
data "Coppy",5
data "Paste",6
data "Bold",7
data "Italics",8
data "Normal",9
data "Undeline",10
data "Uppercase",37
data "Lowercase",38
return
m3:
data "Lucida Console",15
data "Impact",16
data "AvantGarde Bk BT",17
data "Swiss911 XCm BT",18
data "WP BoxDrawing",19
data "Cuckoo",20
data "Tristan",21
data "Aurora Cn BT",22
data "Informal011 BT",23
data "Unicorn",24
data "MS Mincho",25
data "MS Gothic",26
data "GulimChe",27
data "DotumChe",28
data "BatangChe",29
data "Gungsuh",30
data "GungsuhChe",31
data "SimSun",32
data "NSimSun",33
data "MingLiU",34
data "Fixedsys",35
m4:
data "123",163
data "124",162
data "125",161
data "126",160
data "127",159
data "128",158
data "129",157
data "130",156
data "131",130
data "132",131
data "133",132
data "134",133
data "135",134
data "136",135
data "137",136
data "138",137
data "139",138
data "140",139
data "141",140
data "142",141
data "143",142
data "144",143
data "145",144
data "146",145
data "147",146
data "148",147
data "149",148
data "150",149
data "151",150
data "152",151
data "153",152
data "154",153
data "159",154
data "160",155
data "161",104
data "162",105
data "163",106
data "164",107
data "165",108
data "171",109
data "172",110
data "173",111
data "174",112
data "175",113
data "176",114
data "177",115
data "178",116
data "179",117
data "180",118
data "181",119
data "182",120
data "183",121
data "184",122
data "185",123
data "186",124
data "187",125
data "188",126
data "189",127
data "190",128
data "191",129
data "192",40
data "193",41
data "194",42
data "195",43
data "196",44
data "197",45
data "198",46
data "199",47
data "200",48
data "201",49
data "202",50
data "203",51
data "204",52
data "205",53
data "206",54
data "207",55
data "208",56
data "209",57
data "210",58
data "211",59
data "212",60
data "213",61
data "214",62
data "215",63
data "216",64
data "217",65
data "218",66
data "219",67
data "220",68
data "221",69
data "222",70
data "223",71
data "224",72
data "225",73
data "226",74
data "227",75
data "228",76
data "229",77
data "230",78
data "231",79
data "232",80
data "233",81
data "234",82
data "235",83
data "236",84
data "237",85
data "238",86
data "239",87
data "240",88
data "241",89
data "242",90
data "243",91
data "244",92
data "245",93
data "246",94
data "247",95
data "248",96
data "249",97
data "250",98
data "251",99
data "242",100
data "243",101
data "254",102
data "255",103

#CONSTANT TRUE = 1
#CONSTANT FALSE = 0
#CONSTANT SCROLLBARSIZE = 12
#CONSTANT TITLEBARSIZE = 18
#CONSTANT MIN_WIDTH = 40
#CONSTANT MIN_HEIGHT = 30
#CONSTANT VK_BACKSPACE = 8
#CONSTANT VK_RETURN = 13
#CONSTANT VK_DELETE = 211
#CONSTANT VK_COPY = 3
#CONSTANT VK_PASTE = 22
Global NEW_FILE$ = "Untitled"
Global CLICK_FLAG = 0         : `mouse is pressed down
Global CARET_STAMP = 0        : `timestamp for cursor blink rate
Global CARET$ = "|"           : `the cursor to display
Global VK_FLAG = 0            : `if an arrow key is being pressed
global _mouseFlag = 0         : `used with menu functions
Global status_message$ = ""   : `message displayed in status bar


type Menu
   name as string              ` name of this menu
   active as boolean           ` enabled/disabled
   width as integer            ` width of this menu
   count as integer            ` item count
endtype

type MenuItem
   parentID as integer         `id of menu this item belongs to
   item as string              `name of this item
   enabled as boolean          `enabled/disabled
   check as integer            `unused
endtype

type Files
   name as string              `name of file for read/write
   maxWidth as integer         `number of chars in longest line
   textIndex as integer        `beginnging of this file's text in the string array
   textEnd as integer          `ending of this file's text in the string array
endtype

type Window
   x as integer                `X position of window
   y as integer                `Y position of window
   width as integer            `width of window
   height as integer           `height of window
   fileIndex as integer        `index in file array this window references
   thumbX as integer           `scrollbar thumb X position (horizontal)
   thumbY as integer           `scrollbar thumb Y position (vertical)
   thumbHeight as integer      `scrollbar thumb height (vertical)
   thumbWidth as integer       `scrollbar thumb width (horizontal)
   thumbXFlag as boolean       `horizontal scrollbar moving
   thumbYFlag as boolean       `vertical scrollbar moving
   thumbOffsetX as integer     `offset from where mouse clicked horizontal scrollbar
   thumbOffsetY as integer     `offset from where mouse clicked vertical scrollbar
   showVertical as boolean     `show/hide vertical scrollbar
   showHorizontal as boolean   `show/hide horizontal scrollbar
   titleFlag as boolean        `window is being dragged
   titleOffsetX as integer     `offset of where window title bar was grabbed with mouse X
   titleOffsetY as integer     `offset of where window title bar was grabbed with mouse Y
   resizeFlag as boolean       `window is being resized
   resizeOffsetX as integer    `offset X from where mouse clicked resize corner
   resizeOffsetY as integer    `offset Y from where mouse clicked resize corner
   startingLine as integer     `what line number to start displaying text from (vertical scrolling)
   startingChar as integer     `what character position to start displaying text from (horizontal scrolling)
   showLineNumbers as boolean  `show/hide line number border
   visibleLines as integer     `how many lines this window can display at one time
   visibleChars as integer     `how many characters across this window can display at one time
   selectedRow as integer      `what line number is being edited
   caretPos as integer         `character position of cursor in 'selectedRow'
endtype


type SelectionNode
   row as integer              `which line of text (from array __textLines$)
   char as integer             `character position within that line
endtype

type SelectionRange
   start as SelectionNode      `beginning of selection
   finish as SelectionNode     `end of selection
endtype

Global _selection as SelectionRange


dim __openFiles(0) as Files   : `array of opened files
dim __windows(0) as Window    : `array of displayed windows
dim __textLines$(0) as string : `holds lines of text from all files
                              : `"File" indices reference this array

dim menus() as Menu           : `array of menus
dim menuItems() as MenuItem   : `array of menu items from all menus


MENU_FILE = addMenu("File")
MENU_EDIT = addMenu("Edit")
MENU_TOOLS = addMenu("Tools")
addMenuItem(MENU_FILE,"New",TRUE,-1)
addMenuItem(MENU_FILE,"Open",TRUE,-1)
addMenuItem(MENU_FILE,"Save",TRUE,-1)
addMenuItem(MENU_FILE,"Save As",TRUE,-1)
addMenuItem(MENU_FILE,"Close Window",TRUE,-1)
addMenuItem(MENU_FILE,"------------",TRUE,-1)
addMenuItem(MENU_FILE,"Exit",TRUE,-1)
addMenuItem(MENU_EDIT,"Cut",TRUE,-1)
addMenuItem(MENU_EDIT,"Copy",TRUE,-1)
addMenuItem(MENU_EDIT,"Paste",TRUE,-1)
addMenuItem(MENU_TOOLS,"Word Count",TRUE,-1)
addMenuItem(MENU_TOOLS,"Character Count",TRUE,-1)


set display mode 1024,768,16
`sync on
`backdrop on
`color backdrop rgb(0,0,255)


`openFile("c:teTest.txt") : `non-existant file, creates blank
`openFile("c:test.txt")
`openFile("c:vraylog.txt")
`openFile("c:thing.txt")

status_message$ = "status bar"


DO
   cls

   handleWindows()

   handleMenus()

   handleStatusBar()

   `text 2,200,prevRow$
   `fastsync
LOOP



REM **********************************
REM handles all functionality of menus
REM **********************************
function handleMenus()
   _mc = mouseclick()
   if _mc = 0 then _mouseFlag = 0
   v$ = _handleMenus$(_mc)
   if v$ = "Edit-Copy" then copyText()
   if v$ = "Edit-Paste" then pasteText()
   if v$ = "File-New" then openFile(NEW_FILE$)
   if v$ = "File-Open" then openDialog()
   if v$ = "File-Save" then saveFile("")
   if v$ = "File-Save As" then saveAsDialog()
   if v$ = "File-Exit" then end
   if v$ = "File-Close Window" then closeWindow()
   if v$ = "Tools-Word Count" then countWords()
   if v$ = "Tools-Character Count" then countCharacters()

endfunction



REM ****************************
REM Handles rendering and UI
REM of all text document windows
REM ****************************
function handleWindows()
   hwind = 0
   count = array count(__windows())
   for i = 1 to count
      _drawWindow(i)
      h = _handleWindowUI(count+1-i)
      if h > hwind then hwind = h
   next i

   rem order last window focused on top
   if hwind > 0 and hwind < count
      temp as Window
      temp = __windows(hwind)
      for i = hwind to count-1
         __windows(i) = __windows(i+1)
      next i
      __windows(count) = temp
   endif
   if mouseclick() = 0 then CLICK_FLAG = 0

   _handleFocused()

endfunction


REM **********************************
REM Functionality for whichever window
REM currently has focus
REM **********************************
function _handleFocused()
   index = array count(__windows())
   x = __windows(index).x
   y = __windows(index).y
   width = __windows(index).width
   height = __windows(index).height
   thumbX = __windows(index).thumbX
   thumbY = __windows(index).thumbY
   thumbHeight = __windows(index).thumbHeight
   fileIndex = __windows(index).fileIndex
   textIndex = __openFiles(fileIndex).textIndex
   lineCount = __openFiles(fileIndex).textEnd - textIndex
   lineHeight = text height("A")
   visibleLines = __windows(index).visibleLines

   editLines(index)

   if __windows(index).showVertical = TRUE
      mmz = mousemovez()
      if mmz < 0 then thumbY = thumbY + 10
      if mmz > 0 then thumbY = thumbY - 10

      if thumbY < 0 then thumbY = 0
      if thumbY > height-thumbHeight then thumbY = height-thumbHeight
      __windows(index).thumbY = thumbY
      __windows(index).startingLine = textIndex + ((lineCount-visibleLines+1)*thumbY) / (height-thumbHeight)
   endif
endfunction



REM *********************************
REM Handles too many different things
REM than a single function should do
REM *********************************
function editLines(index as integer)
   x = __windows(index).x
   y = __windows(index).y
   width = __windows(index).width
   height = __windows(index).height
   caret = __windows(index).caretPos
   row = __windows(index).selectedRow
   fi = __windows(index).fileIndex
   startingLine = __windows(index).startingLine
   startingChar = __windows(index).startingChar
   fileIndex = __windows(index).fileIndex
   visibleChars = __windows(index).visibleChars
   lineHeight = text height("A")
   charWidth = text width("A")


   rem position cursor with mouse
   if mouseclick() = 1

      if mouseWithin(x,y,x+width,y+height)
         t_row = (mousey() - y) / lineHeight
         t_caretPos = (mousex() - x) / charWidth + startingChar
         t_row = startingLine + t_row
         if t_row > __openFiles(fileIndex).textEnd then t_row = __openFiles(fileIndex).textEnd
         `__windows(index).selectedRow = row
         fPos = len(__textLines$(t_row))
         if t_caretPos > fPos then t_caretPos = fPos
         `caret = __windows(index).caretPos

         if CLICK_FLAG = 0
            CLICK_FLAG = 1

            row = t_row
            caret = t_caretPos
            __windows(index).caretPos = caret
            __windows(index).selectedRow = row

            _selection.start.row = row
            _selection.start.char = caret

         else
            _selection.finish.row = t_row
            _selection.finish.char = t_caretPos
         endif
      endif
   endif

   rem position cursor with arrow keys
   if upkey() and VK_FLAG = 0
      VK_FLAG = 1
      dec row
      if row < 1 then row = 1
      __windows(index).selectedRow = row
      fPos = len(__textLines$(row))
      if caret > fPos then caret = fPos
   endif
   if downkey() and VK_FLAG = 0
      VK_FLAG = 1
      inc row
      lineCount = __openFiles(fileIndex).textEnd - __openFiles(fileIndex).textIndex
      if row > lineCount then row = lineCount
      __windows(index).selectedRow = row
      fPos = len(__textLines$(row))
      if caret > fPos then caret = fPos
   endif
   if rightkey() and VK_FLAG = 0
      VK_FLAG = 1
      inc caret
      fPos = len(__textLines$(row))
      if caret > fpos then caret = fpos
   endif
   if leftkey() and VK_FLAG = 0
      VK_FLAG = 1
      dec caret
      if caret < 0 then caret = 0
   endif
   if upkey() = 0 and downkey() = 0 and rightkey() = 0 and leftkey() = 0
      VK_FLAG = 0
   else
      __windows(index).caretPos = caret
   endif


   rem text input
   lineText$ = __textLines$(row)
   buffer$ = entry$()
   for i = 1 to len(buffer$)
      ink rgb(255,255,255),0
      set cursor 10,220
      print asc(mid$(buffer$,i))
      select asc(mid$(buffer$,i))
         case VK_COPY
            copyText()
         endcase
         case VK_PASTE
            pasteText()
         endcase
         case VK_BACKSPACE
            if caret > 0
               t$ = left$(lineText$,caret-1)
               lineText$ = t$ + right$(lineText$, len(lineText$)-len(t$)-1)
               dec caret
            else
               if row > startingLine
                  prevRow$ = __textLines$(row-1)
                  lineText$ = prevRow$ + lineText$
                  deleteLine(fi, row)
                  caret = len(prevRow$)
                  dec row
               endif
            endif
         endcase
         case VK_RETURN
            t$ = left$(lineText$,caret)
            __textLines$(row) = t$
            lineText$ = right$(lineText$, len(lineText$)-len(t$))
            insertLine(fi,lineText$,row+1)
            caret = 0
            inc row
         endcase
         case VK_DELETE
            if caret < len(lineText$)
               t$ = left$(lineText$, caret-1)
               __textLines$(row) = right$(lineText$, len(lineText$)-(len(t$)+1))
            else

            endif
         endcase
         case default
            t$ = left$(lineText$,caret)
            lineText$ = t$ + mid$(buffer$,i) + right$(lineText$, len(lineText$)-len(t$))
            inc caret
            if caret-startingChar > visibleChars then __windows(index).startingChar = __windows(index).startingChar+1
         endcase
      endselect
   next i
   clear entry buffer
   __textLines$(row) = lineText$
   __windows(index).caretPos = caret
   __windows(index).selectedRow = row


   rem check if new scrollbars are needed
   rem horizontal
   if len(lineText$) > __openFiles(fileIndex).maxWidth
       __openFiles(fileIndex).maxWidth = len(lineText$)-1
       _resizeWindow(index)
   endif
   rem vertical
   if (__openFiles(fileIndex).textEnd - __openFiles(fileIndex).textIndex) > __windows(index).visibleLines
      _resizeWindow(index)
   endif


   rem blinking cursor
   if timer() >= CARET_STAMP+500
      CARET_STAMP = timer()
      if CARET$ = "|"
         CARET$ = ""
      else
         CARET$ = "|"
      endif
   endif
   if startingChar > 0 then caret = caret+1
   if __windows(index).startingChar < 0 then __windows(index).startingChar = 0
   cy = y+(row-startingLine)*lineHeight
   cx = x+(caret-startingChar)*charWidth
   if cy >= y and cy < y+height and cx >= x and cx < x+width then text cx,cy,CARET$

endfunction



REM *******************************
REM inserts a new line into a file
REM 'fileIndex' file to insert into
REM 'txt' text to insert
REM 'row' line number to insert at
REM *******************************
function insertLine(fileIndex as integer, txt as string, row as integer)

   if row < array count(__textLines$())
      array insert at element __textLines$(), row
   else
      array insert at bottom __textLines$()
   endif
   __textLines$(row) = txt
   __openFiles(fileIndex).textEnd = __openFiles(fileIndex).textEnd+1

   for f = fileIndex+1 to array count(__openFiles())
      __openFiles(f).textIndex = __openFiles(f).textIndex+1
      __openFiles(f).textEnd = __openFiles(f).textEnd+1
   next f

   for w = 1 to array count(__windows())
      if __windows(w).fileIndex > fileIndex then __windows(w).startingLine = __windows(w).startingLine + 1
   next w

endfunction



REM ***************************************
REM Removes a line from a text file
REM Adjusts indices of other affected files
REM using the __textLines$() array
REM 'fileIndex' file to remove line from
REM 'row' line number to remove
REM ***************************************
function deleteLine(fileIndex as integer, row as integer)
   array delete element __textLines$(), row

   __openFiles(fileIndex).textEnd = __openFiles(fileIndex).textEnd - 1

   for f = fileIndex+1 to array count(__openFiles())
      __openFiles(f).textIndex = __openFiles(f).textIndex - 1
      __openFiles(f).textEnd = __openFiles(f).textEnd - 1
   next f

   for w = 1 to array count(__windows())
      if __windows(w).fileIndex > fileIndex then __windows(w).startingLine = __windows(w).startingLine - 1
   next w
endfunction


REM ***********************************
REM Prompts user with a save dialog box
REM Then attempts to save the file
REM ***********************************
function saveAsDialog()
   file$ = removeTrailingSpaces$(_open_save("Text File (*.txt)|*.txt|All Files (*.*)|*.*|",get dir$(),"Save File","*.*",0))
   if file$ <> "" and mid$(file$,1) <> "!" then saveFile(file$)
endfunction



REM *************************************
REM saves a text file
REM if 'file' is an empty string,
REM file is saved under its given path.
REM if 'file' is not empty, the save
REM function acts as a Save As function
REM and saves the file under the new name
REM and associates it with that path
REM from then on.
REM *************************************
function saveFile(file as string)
   index = array count(__windows())
   fileIndex = __windows(index).fileIndex
   start = __openFiles(fileIndex).textIndex
   finish = __openFiles(fileIndex).textEnd


   if file = ""
      file = __openFiles(fileIndex).name
      if file = NEW_FILE$
         saveAsDialog()
         exitfunction
      endif
      status_message$ = "File saved"
   else
      __openFiles(fileIndex).name = file
      status_message$ = "File saved as "+file
   endif

   `tempFile$ = "$_"+file
   `if path exist(tempFile$) then delete file tempFile$
   if path exist(file) then delete file file
   open to write 1, file
   for i = start to finish
      write string 1, __textLines$(i)
   next i
   close file 1


   `if path exist(file) then delete file file
   `rename file tempFile$, file

endfunction



REM ************************************
REM Prompts user with an open dialog box
REM Then attempts to open selected file
REM ************************************
function openDialog()
   file$ = removeTrailingSpaces$(_open_save("Text File (*.txt)|*.txt|All Files (*.*)|*.*|",get dir$(),"Open File","*.*",1))
   if mid$(file$,1) <> "!" then openFile(file$)
endfunction



REM ****************
REM open a text file
REM ****************
function openFile(file as string)

   rem local variables
   fileLoaded = 0
   maxWidth = 0
   currentTextIndex = array count(__textLines$())+1

   if file = NEW_FILE$
      array insert at bottom __textLines$()
      maxWidth = 1
      fileLoaded = TRUE
   endif

   rem does the file exist
   if fileLoaded = FALSE and path exist(file) = TRUE
      rem make sure this is a text file
      `if lower$(right$(file,4)) = ".txt"
         open to read 1, file
         rem read in all the lines from the file into the array
         while file end(1) = 0
            read string 1, z$
            if len(z$) > maxWidth then maxWidth = len(z$)
            array insert at bottom __textLines$()
            __textLines$(array count(__textLines$())) = z$
         endwhile
         close file 1
         fileLoaded = 1
      `endif
   endif

   rem file loaded
   if fileLoaded = TRUE
      status_message$ = "File opened: "+file
      rem store structure of file
      array insert at bottom __openFiles()
      fi = array count(__openFiles())
      __openFiles(fi).maxWidth = maxWidth-1
      __openFiles(fi).name = file
      __openFiles(fi).textIndex = currentTextIndex
      __openFiles(fi).textEnd = array count(__textLines$())
      rem create the window
      array insert at bottom __windows()
      i = array count(__windows())
      __windows(i).x = 10
      __windows(i).y = 40
      __windows(i).width = 500
      __windows(i).height = 300
      __windows(i).fileIndex = fi
      __windows(i).startingLine = __openFiles(fi).textIndex
      __windows(i).showLineNumbers = FALSE
      __windows(i).visibleLines = __windows(i).height/text height("A")
      __windows(i).visibleChars = __windows(i).width / text width("W")
      lineCount = __openFiles(fi).textEnd - __openFiles(fi).textIndex
      if lineCount = 0
         __windows(i).thumbHeight = 1
      else
         __windows(i).thumbHeight = (__windows(i).visibleLines * __windows(i).height) / lineCount
      endif
      if __openFiles(fi).maxWidth <= 0
         __openFiles(fi).maxWidth = 1
         __windows(i).thumbWidth = 1
      else
         __windows(i).thumbWidth = ((__windows(i).width/text width("A"))*__windows(i).width) / __openFiles(fi).maxWidth
      endif
      if __windows(i).thumbHeight < __windows(i).height then __windows(i).showVertical = TRUE
      if __windows(i).thumbWidth < __windows(i).width then __windows(i).showHorizontal = TRUE
   endif
endfunction



REM *************************************
REM copies selected text to the clipboard
REM from the currently active window
REM *************************************
function copyText()
   selectionFlag = 1
   if _selection.start.row = _selection.finish.row and _selection.start.char = _selection.finish.char then selectionFlag = 0
   if _selection.start.char > _selection.finish.char then selectionFlag = 0

   copy$ = ""
   if selectionFlag = 1
      `if _selection.start.row = _selection.finish.row
      for i = _selection.start.row to _selection.finish.row
         t$ = __textLines$(i)
         a = 1
         b = len(t$)
         if i = _selection.start.row
            a = _selection.start.char
            if a > 1 then a = a+1
         endif
         if i = _selection.finish.row : b = _selection.finish.char : newLine$ = "" : else : newLine$ = chr$(10) : endif
         copy$ = copy$ + substring$(t$,a,b) + newLine$
      next i
   endif
   write to clipboard copy$
endfunction



REM ****************************************
REM pastes contents of clipboard into window
REM at the cursor's position
REM BUGGY!!! why?
REM ****************************************
function pasteText()
   rem focused window is always at end of array
   index = array count(__windows())
   fileIndex = __windows(index).fileIndex
   textIndex = __openFiles(fileIndex).textIndex
   caret = __windows(index).caretPos
   row = __windows(index).selectedRow

   cb$ = get clipboard$()
   t$ = left$(__textLines$(row),caret)
   e$ = right$(__textLines$(row),len(__textLines$(row))-caret)
   `__textLines$(row) = t$ + cb$


   for i = 1 to len(cb$)
      c$ = mid$(cb$,i)
      if c$ = chr$(10) OR c$ = chr$(13)
         insertLine(fileIndex, t$, row)
         t$ = ""
         inc row
      else
         t$ = t$ + c$
      endif
   next i

   if t$ <> "" then insertLine(fileIndex, t$, row)

   __textLines$(row) = __textLines$(row) + e$

endfunction


function handleStatusBar()
   sh = screen height()
   sw = screen width()
   size = 16
   ink rgb(192,192,192),0
   box 0,sh-size,sw,sh

   ink 0,0
   line 0,sh-size,sw,sh-size
   line 0,sh-size,0,sh
   text 10,sh-size,status_message$

endfunction


REM *******************
REM draws a text window
REM *******************
function _drawWindow(index as integer)
   x = __windows(index).x
   y = __windows(index).y
   width = __windows(index).width
   height = __windows(index).height
   thumbX = __windows(index).thumbX
   thumbY = __windows(index).thumbY
   fileIndex = __windows(index).fileIndex
   textIndex = __openFiles(fileIndex).textIndex
   lineCount = __openFiles(fileIndex).textEnd - textIndex
   maxWidth = __openFiles(fileIndex).maxWidth
   lineHeight = text height("A")
   charWidth = text width("A")
   visibleChars = __windows(index).visibleChars
   visibleLines = __windows(index).visibleLines
   thumbHeight = __windows(index).thumbHeight
   thumbWidth = __windows(index).thumbWidth
   startingChar = __windows(index).startingChar


   displayName$ = __openFiles(fileIndex).name
   if text width(displayName$) > width
      t = width/charWidth - 3
      displayName$ = left$(displayName$,t)+"..."
   endif

   rem title bar
   if index < array count(__windows())
      c1 = rgb(192,192,192)
      c2 = rgb(128,128,128)
   else
      c1 = rgb(10,36,106)
      c2 = rgb(166,202,240)
   endif
   box x,y-TITLEBARSIZE,x+width+SCROLLBARSIZE,y,c1,c2,c1,c2
   ink rgb(225,225,225),0
   text x+2,y-TITLEBARSIZE,displayName$


   rem scrollbars
   rem vertical
   rem track
   ink rgb(192,192,192),0
   box x+width,y,x+width+SCROLLBARSIZE,y+height
   rem thumb
   if __windows(index).showVertical = TRUE
      ink rgb(128,128,128),0
      box x+width,y+thumbY,x+width+SCROLLBARSIZE,y+thumbY+thumbHeight
      ink rgb(200,200,200),0
      line x+width,y+thumbY,x+width+SCROLLBARSIZE,y+thumbY
      line x+width,y+thumbY,x+width,y+thumbY+thumbHeight
      ink rgb(40,40,40),0
      line x+width+SCROLLBARSIZE,y+thumbY,x+width+SCROLLBARSIZE,y+thumbY+thumbHeight
      line x+width,y+thumbY+thumbHeight,x+width+SCROLLBARSIZE,y+thumbY+thumbHeight
   endif
   rem horizontal
   rem track
   ink rgb(192,192,192),0
   box x,y+height,x+width,y+height+SCROLLBARSIZE
   rem thumb
   if __windows(index).showHorizontal = TRUE
      ink rgb(128,128,128),0
      box x+thumbX,y+height,x+thumbX+thumbWidth,y+height+SCROLLBARSIZE
      ink rgb(200,200,200),0
      line x+thumbX,y+height,x+thumbX+thumbWidth,y+height
      line x+thumbX,y+height,x+thumbX,y+height+SCROLLBARSIZE
      ink rgb(40,40,40),0
      line x+thumbX,y+height+SCROLLBARSIZE,x+thumbX+thumbWidth,y+height+SCROLLBARSIZE
      line x+thumbX+thumbWidth,y+height,x+thumbX+thumbWidth,y+height+SCROLLBARSIZE
   endif
   rem lower corner where 2 scrollbars meet
   ink rgb(128,128,128),0
   box x+width,y+height,x+width+SCROLLBARSIZE,y+height+SCROLLBARSIZE

   rem background
   ink rgb(208,219,219),0
   box x,y,x+width,y+height
   rem background shadow
   ink rgb(25,25,25),0
   box x+4,y+height+SCROLLBARSIZE,x+width+SCROLLBARSIZE+4,y+height+SCROLLBARSIZE+4
   box x+width+SCROLLBARSIZE,y-TITLEBARSIZE+4,x+width+SCROLLBARSIZE+4,y+height+SCROLLBARSIZE


   rem if show line numbers, draw the border
   if __windows(index).showLineNumbers = TRUE
      tOffset = text width(str$(lineCount)+" ")+4
      box x,y,x+tOffset-4,y+height,rgb(208,219,219),rgb(208,219,219),rgb(160,171,171),rgb(160,171,171)
      ink rgb(128,128,128),0
      box x+tOffset-5,y,x+tOffset-4,y+height
      alignSize = len(str$(lineCount))
   else
      tOffset = 2
   endif


   selectionFlag = 1
   if _selection.start.row = _selection.finish.row and _selection.start.char = _selection.finish.char then selectionFlag = 0
   if _selection.start.char > _selection.finish.char then selectionFlag = 0


   rem the text routine
   startingLine = __windows(index).startingLine
   for i = startingLine to startingLine + visibleLines-1
      L = i - startingLine
      if i <= __openFiles(fileIndex).textEnd
         rem display line number border
         if __windows(index).showLineNumbers = TRUE then text x+2,y+L*lineHeight, justify$(str$(i-textIndex+1),alignSize,0)

         rem get visible text
         if i > 0 and i <= array count(__textLines$()) then t$ = substring$(__textLines$(i), startingChar,startingChar+visibleChars)

         rem reset text color for the line to be displayed
         ink 0,0
         rem draw selection boxes
         if selectionFlag = 1
            rem if this line is part of the selection
            if i >= _selection.start.row and i <= _selection.finish.row
               sy1 = y+L*lineHeight
               rem if this entire line should be highlighted
               if i > _selection.start.row and i < _selection.finish.row
                  sx1 = x+tOffset
                  sx2 = sx1+len(t$)*charWidth
                  ink rgb(0,0,255),0
                  box sx1,sy1,sx2,sy1+lineHeight
                  ink rgb(255,255,255),0
                  text x+tOffset,sy1, t$
               else `i is either first or last row of selection
                  rem if selection is all on same line
                  if _selection.start.row = _selection.finish.row
                     sx1 = x+tOffset+_selection.start.char*charWidth
                     sx2 = x+tOffset+_selection.finish.char*charWidth
                     ink rgb(0,0,255),0
                     box sx1,sy1,sx2,sy1+lineHeight
                     ink rgb(255,255,255),0
                     c1 = _selection.start.char
                     c2 = _selection.finish.char
                     if _selection.start.char < startingChar then c1 = startingChar
                     if _selection.finish.char > startingChar+visibleChars then c2 = startingChar+visibleChars
                     middle$ = substring$(__textLines$(i), c1, c2)
                     edge = 1
                     if _selection.start.char = startingChar then edge = 0
                     text x+tOffset+(_selection.start.char-startingChar-edge)*charWidth,sy1,middle$
                     begin$ = substring$(__textLines$(i),startingChar,_selection.start.char)
                     last$ = substring$(__textLines$(i),_selection.finish.char+1,startingChar+visibleChars)
                     ink 0,0
                     text x+tOffset,sy1,begin$
                     text x+tOffset+(len(middle$+begin$)-edge)*charWidth,sy1,last$
                  else
                     rem first row of a multi-line selection
                     if i = _selection.start.row
                        sx1 = x+tOffset+_selection.start.char*charWidth
                        sx2 = x+tOffset+len(t$)*charWidth
                        begin$ = substring$(__textLines$(i),startingChar,_selection.start.char)
                        last$ = substring$(__textLines$(i),_selection.start.char+1,startingChar+visibleChars)
                        sx1 = x+tOffset+len(begin$)*charWidth
                        sx2 = x+tOffset+len(t$)*charWidth
                        ink rgb(0,0,255),0
                        box sx1,sy1,sx2,sy1+lineHeight
                        ink rgb(255,255,255),0
                        text x+tOffset+len(begin$)*charWidth,sy1,last$
                        ink 0,0
                        text x+tOffset,sy1,begin$
                     else `last row of a multi-line selection
                        sx1 = x+tOffset
                        sx2 = x+tOffset+_selection.finish.char*charWidth
                        begin$ = substring$(__textLines$(i),startingChar,_selection.finish.char)
                        last$ = substring$(__textLines$(i),_selection.finish.char+1,startingChar+visibleChars)
                        sx1 = x+tOffset
                        sx2 = x+tOffset+len(begin$)*charWidth
                        ink rgb(0,0,255),0
                        box sx1,sy1,sx2,sy1+lineHeight
                        ink rgb(255,255,255),0
                        text x+tOffset,sy1,begin$
                        ink 0,0
                        text x+tOffset+len(begin$)*charWidth,sy1,last$
                     endif
                  endif
               endif
            else
               rem display text
               text x+tOffset,y+L*lineHeight, t$
            endif
         else
            rem display text
            text x+tOffset,y+L*lineHeight, t$
         endif


      endif
   next i

endfunction




REM ********************
REM handles UI of window
REM ********************
function _handleWindowUI(index as integer)
   x = __windows(index).x
   y = __windows(index).y
   width = __windows(index).width
   height = __windows(index).height
   thumbX = __windows(index).thumbX
   thumbY = __windows(index).thumbY
   thumbHeight = __windows(index).thumbHeight
   thumbWidth = __windows(index).thumbWidth
   fileIndex = __windows(index).fileIndex
   textIndex = __openFiles(fileIndex).textIndex
   lineCount = __openFiles(fileIndex).textEnd - textIndex
   maxWidth = __openFiles(fileIndex).maxWidth
   lineHeight = text height("A")
   visibleLines = __windows(index).visibleLines
   visibleChars = __windows(index).visibleChars
   grabbedWindow = 0

   if thumbY < 0 then thumbY = 0
   if thumbY > height-thumbHeight then thumbY = height-thumbHeight
   __windows(index).thumbY = thumbY

   if mouseclick() = 1
      rem handle vertical scrollbar
      if __windows(index).showVertical = TRUE
         if CLICK_FLAG = 0 and mouseWithin(x+width,y+thumbY,x+width+SCROLLBARSIZE,y+thumbY+thumbHeight)
            __windows(index).thumbYFlag = TRUE
            __windows(index).thumbOffsetY = thumbY - mousey()
            CLICK_FLAG = 1
         endif
         if __windows(index).thumbYFlag = TRUE
            thumbY = mousey() + __windows(index).thumbOffsetY
            if thumbY < 0 then thumbY = 0
            if thumbY > height-thumbHeight then thumbY = height-thumbHeight
            __windows(index).thumbY = thumbY
            __windows(index).startingLine = textIndex + ((lineCount-visibleLines+1)*thumbY) / (height-thumbHeight)
         endif
      endif

      rem handle horizontal scrollbar
      if __windows(index).showHorizontal = TRUE
         if CLICK_FLAG = 0 and mouseWithin(x+thumbX,y+height,x+thumbX+thumbWidth,y+height+SCROLLBARSIZE)
            __windows(index).thumbXFlag = TRUE
            __windows(index).thumbOffsetX = thumbX - mousex()
            CLICK_FLAG = 1
         endif
         if __windows(index).thumbXFlag = TRUE
            thumbX = mousex() + __windows(index).thumbOffsetX
            if thumbX < 0 then thumbX = 0
            if thumbX > width-thumbWidth then thumbX = width-thumbWidth
            __windows(index).thumbX = thumbX
            __windows(index).startingChar = ((maxWidth-visibleChars)*thumbX) / (width-thumbWidth)
         endif
      endif

      rem handle titlebar
      if CLICK_FLAG = 0 and mouseWithin(x,y-TITLEBARSIZE,x+width+SCROLLBARSIZE,y)
         __windows(index).titleFlag = TRUE
         __windows(index).titleOffsetX = x - mousex()
         __windows(index).titleOffsetY = y - mousey()
         CLICK_FLAG = 1
      endif
      if __windows(index).titleFlag = TRUE
         __windows(index).x = mousex() + __windows(index).titleOffsetX
         __windows(index).y = mousey() + __windows(index).titleOffsetY
      endif

      rem handle resizing
      if CLICK_FLAG = 0 and mouseWithin(x+width,y+height,x+width+SCROLLBARSIZE,y+height+SCROLLBARSIZE)
         __windows(index).resizeFlag = TRUE
         __windows(index).resizeOffsetX = x+width - mousex()
         __windows(index).resizeOffsetY = y+height - mousey()
         CLICK_FLAG = 1
      endif
      if __windows(index).resizeFlag = TRUE
         __windows(index).width = mousex() - __windows(index).x + __windows(index).resizeOffsetX
         __windows(index).height = mousey() - __windows(index).y + __windows(index).resizeOffsetY
         if __windows(index).width < MIN_WIDTH then __windows(index).width = MIN_WIDTH
         if __windows(index).height < MIN_HEIGHT then __windows(index).height = MIN_HEIGHT
         _resizeWindow(index)
      endif

      rem if windows was clicked on, make it top component
      if CLICK_FLAG = 0 and mouseWithin(x,y-TITLEBARSIZE,x+width+SCROLLBARSIZE,y+height)
         grabbedWindow = index
         `CLICK_FLAG = 1
      endif

   else
      __windows(index).thumbXFlag = FALSE
      __windows(index).thumbYFlag = FALSE
      __windows(index).titleFlag = FALSE
      __windows(index).resizeFlag = FALSE
   endif

endfunction grabbedWindow



REM ******************************
REM this is called whenever a
REM window's size has been changed
REM recalculates scrollbar and
REM viewing sizes
REM ******************************
function _resizeWindow(index as integer)
   fi = __windows(index).fileIndex
   lineCount = __openFiles(fi).textEnd - __openFiles(fi).textIndex + 1
   __windows(index).visibleLines = __windows(index).height/text height("A")
   __windows(index).thumbHeight = (__windows(index).visibleLines * __windows(index).height) / lineCount
   __windows(index).thumbWidth = ((__windows(index).width/text width("A"))*__windows(index).width) / __openFiles(fi).maxWidth
   __windows(index).visibleLines = __windows(index).height/text height("A")
   __windows(index).visibleChars = __windows(index).width / text width("W")

   if __windows(index).thumbHeight < __windows(index).height
      __windows(index).showVertical = TRUE
   else
      __windows(index).showVertical = FALSE
   endif
   if __windows(index).thumbWidth < __windows(index).width
      __windows(index).showHorizontal = TRUE
   else
      __windows(index).showHorizontal = FALSE
   endif

   `__windows(index).thumbX = (__windows(index).startingChar*(__windows(index).width - __windows(index).thumbWidth)) / (__openFiles(fi).maxWidth - __windows(index).visibleChars)

endfunction



REM ***************************
REM Create a new drop-down menu
REM ***************************
function addMenu(name as string)
   m as Menu
   m.name = name
   array insert at bottom menus()
   count = array count(menus())
   menus(count) = m
endfunction count


REM *****************************
REM add a menu item to menu 'pid'
REM *****************************
function addMenuItem(pid as integer, item as string, enabled as boolean, check as integer)
   m as MenuItem
   m.parentID = pid
   m.item = item
   m.enabled = enabled
   m.check = check
   array insert at bottom menuItems()
   menuItems(array count(menuItems())) = m

   rem make sure menu is drawn wide enough to handle this item's name
   width = text width(item)+6
   if width > menus(pid).width then menus(pid).width = width

   menus(pid).count = menus(pid).count + 1
endfunction



REM ********************
REM Handles the menus UI
REM ********************
function _handleMenus$(mc as integer)
   v$ = ""
   offsetX = 0
   active = -1
   activeOffset = 0
   rem text height, vertical spacing
   tw = 16


   rem draw menu bar
   ink rgb(192,192,192),0
   box 0,0,screen width(),tw

   rem clock box
   tx = screen width() - (text width("99:99 :AM")+4)
   ink 0,0
   text tx+2,1,getTime$()
   line tx,1,screen width()-1,1
   line tx,1,tx,tw-1
   ink rgb(255,255,255),0
   line tx,tw-1,screen width()-1,tw-1
   line screen width()-1,1,screen width()-1,tw-1

   for i = 0 to array count(menus())
      width = text width(menus(i).name)

      if mc = 1
         if mousex() >= offsetX and mousex() <= offsetX+width+6 and mousey() >= 0 and mousey() <= tw
            if  _mouseFlag = 0
                _mouseFlag = 1
               if menus(i).active = 0
                  menus(i).active = 1
               else
                  menus(i).active = 0
               endif
               for t = 0 to array count(menus())
                  if t <> i then menus(t).active = 0
               next t
            endif
         endif
      endif

      if menus(i).active = 1
         active = i
         activeOffset = offsetX
         ink rgb(0,180,250),0
         box offsetX,0,offsetX+width+6,tw
      else
         `ink rgb(192,192,192),0
      endif
      `box offsetX,0,offsetX+width+6,tw
      ink 0,0
      text offsetX+3,0,menus(i).name
      offsetX = offsetX + width + 6
   next i


   if active > -1
      ink rgb(192,192,192),0
      box activeOffset,tw,activeOffset+menus(active).width,tw+menus(active).count*tw
      offsetY = 0
      ink 0,0
      for i = 0 to array count(menuItems())
         if menuItems(i).parentID = active
            inc offsetY
            if mousex() > activeOffset and mousex() < activeOffset+menus(active).width and mousey() > offsetY*tw and mousey() < (offsetY+1)*tw
               ink rgb(0,180,250),0
               box activeOffset+1,offsetY*tw+1,activeOffset+menus(active).width-1,(offsetY+1)*tw-1
               rem if this item was clicked
               if mc = 1
                  if _mouseFlag = 0
                     _mouseFlag = 1
                     if menuItems(i).enabled = 1
                        v$ = menus(active).name + "-" + menuItems(i).item
                        menus(active).active = 0
                        exitfunction v$
                     endif
                  endif
               endif
            endif
            if menuItems(i).enabled = 1
               ink 0,0
            else
               ink rgb(120,120,120),0
            endif
            text activeOffset+3,offsetY*tw,menuItems(i).item
         endif
      next i
   endif

endfunction v$



REM **************************************
REM Close the active window
REM technically, i should be releasing
REM all the resources used by this window,
REM but im lazy and its 5:30am
REM **************************************
function closeWindow()
   array delete element __windows(), array count(__windows())

endfunction


REM ****************************************
REM Counts words (3 or more characters)
REM and displays the total in the status bar
REM ****************************************
function countWords()
   fileIndex = __windows(array count(__windows())).fileIndex
   start = __openFiles(fileIndex).textIndex
   finish = __openFiles(fileIndex).textEnd
   total = 0

   for i = start to finish
      t$ = __textLines$(i)
      temp$ = ""
      for j = 1 to len(t$)
         c$ = mid$(t$,j)
         if c$ = " "
            if len(temp$) > 2 then inc total
            temp$ = ""
         else
            temp$ = temp$ + c$
         endif
      next j
      if len(temp$) > 2 then inc total
   next i

   status_message$ = "Word count: "+str$(total)
endfunction



REM ****************************************
REM Counts number of characters
REM and displays the total in the status bar
REM ****************************************
function countCharacters()
   fileIndex = __windows(array count(__windows())).fileIndex
   start = __openFiles(fileIndex).textIndex
   finish = __openFiles(fileIndex).textEnd
   total = 0

   for i = start to finish
      inc total, len(__textLines$(i))
   next i

   status_message$ = "Character count: "+str$(total)
endfunction




REM ****************************
REM returns a substring of 's'
REM beginning and ending indices
REM are both inclusive
REM ****************************
function substring$(s as string, bIndex, eIndex)
   if eIndex < 0 then exitfunction ""
   s = left$(s,eIndex)
   if len(s)-(bIndex-1) < 0 then exitfunction ""
   s = right$(s, len(s)-(bIndex-1))
endfunction s



REM *******************************
REM Returns a string of the current
REM time in 12hour
REM *******************************
function getTime$()
   hour$ = left$(get time$(), 2)
   v = val(hour$)
   day$ = " am"
   if v > 11
      day$ = " pm"
      if v > 12 then hour$ = str$(v-12)
   endif
   if len(hour$) < 2 then hour$ = " "+right$(hour$,1)

   min$ = right$(left$(get time$(),5), 2)
   time$ = hour$+":"+min$+day$
endfunction time$


REM **********************
REM Justifies text
REM 0 for right, 1 for left
REM ***********************
function justify$(s as string, length as integer, alignment as integer)
   if alignment = 0 then s = space$(length - len(s)) + s
   if alignment = 1 then s = s + space$(length - len(s))
endfunction s


REM ****************************
REM returns 1 if mouse is within
REM the defined box area
REM ****************************
function mouseWithin(x1,y1,x2,y2)
   if mousex() > x1 and mousex() < x2 and mousey() > y1 and mousey() < y2 then exitfunction 1
endfunction 0


REM ******************************************
REM removes trailing whitespaces from a string
REM ******************************************
function removeTrailingSpaces$(s as string)
   L = len(s)
   for i = L to 1 step -1
      if mid$(s,i) <> " " then exitfunction left$(s,i)
   next i
endfunction ""





REM ********************************************************
REM *                                                      *
REM *                    Windows Dialogs                   *
REM *                                                      *
REM ********************************************************


Function _open_save(filter As String,initdir As String,dtitle As String,defext As String,open As Boolean)
   `filter = "Text Documents ( *.txt )|*.txt|All Files ( *.* )|*.*|"
   `initdir = "C:"
   `dtitle = "Open ~ Test"
   `defext = "txt"
   `open = 1 For Open Dialogu, 0 for save dialogue


   `Get DLL numbers
   user32 As Integer
   comdlg32 As Integer

   `Load in required DLL's
   user32 = _find_fee_dll()
   Load DLL "user32.dll",user32
   comdlg32 = _find_fee_dll()
   Load DLL "comdlg32.dll",comdlg32


   `Get handle ( unique ID ) to the calling ( this ) window
   hwnd As DWord
   hwnd = Call DLL(user32,"GetActiveWindow")


   `Unload DLL as it is no longer needed
   Delete DLL user32


   `Get the Memblock Number
   OPENFILENAME As Integer
   OPENFILENAME = _find_free_mem()
   `Make The Memblock containing the OPENFILENAME structure
   Make MemBlock OPENFILENAME,76


   `Get the pointer to the just created Structure
   lpofn As DWord
   lpofn = Get MemBlock Ptr(OPENFILENAME)


   `Declare temp variables to hold data for OPENFILENAME structure
   size As Integer
   filebuffer As String
   filebufferptr As DWord
   flags As DWord

   filter = filter + "|"
   initdir = initdir + "|"
   dtitle = dtitle + "|"
   defext = defext + "|"
   filebuffer = "|" + Space$(255) + "|"
   filebufferptr = _get_str_ptr(filebuffer)
   flags = 0x00001000 || 0x00000004 || 0x00000002
   size = 0

   Write MemBlock DWord OPENFILENAME,0,76                     : `lStructSize
   Write MemBlock DWord OPENFILENAME,4,hwnd                   : `hwndOwner
   `Write MemBlock DWord OPENFILENAME,8,NULL                   : `hInstance
   Write MemBlock DWord OPENFILENAME,12,_get_str_ptr(filter)  : `lpstrFilter
   `Write MemBlock DWord OPENFILENAME,16,0                     : `lpstrCustomFilter
   `Write MemBlock DWord OPENFILENAME,20,NULL                  : `nMaxCustFilter
   Write MemBlock DWord OPENFILENAME,24,1                     : `nFilterIndex
   Write MemBlock DWord OPENFILENAME,28,filebufferptr         : `lpstrFile
   Write MemBlock DWord OPENFILENAME,32,256                   : `nMaxFile
   `Write MemBlock DWord OPENFILENAME,36,0                     : `lpstrFileTitle
   `Write MemBlock DWord OPENFILENAME,40,NULL                  : `nMaxFileTitle
   Write MemBlock DWord OPENFILENAME,44,_get_str_ptr(initdir) : `lpstrInitialDir
   Write MemBlock DWord OPENFILENAME,48,_get_str_ptr(dtitle)  : `lpstrTitle
   Write MemBlock DWord OPENFILENAME,52,flags                 : `Flags
   `Write MemBlock Word OPENFILENAME,56,NULL                   : `nFileOffset
   `Write MemBlock Word OPENFILENAME,58,NULL                   : `nFileExtension
   Write MemBlock DWord OPENFILENAME,60,_get_str_ptr(defext)  : `lpstrDefExt
   `Write MemBlock DWord OPENFILENAME,64,NULL                  : `lCustData
   `Write MemBlock DWord OPENFILENAME,68,NULL                  : `lpfnHook
   `Write MemBlock DWord OPENFILENAME,72,0                     : `lpTemplateName


   `Call the Command to open the dialouge
   retval As DWord
   If open
      retval = Call DLL(comdlg32,"GetOpenFileNameA",lpofn)
   Else
      retval = Call DLL(comdlg32,"GetSaveFileNameA",lpofn)
   EndIf

   `Check if it was sucecfull
   If retval <> 0
      code$ = _get_str(filebufferptr,256)
   Else
      retval = Call DLL(comdlg32,"CommDlgExtendedError")
      Select retval
         Case 0xFFFF : code$ = "!The dialog box could not be created. The common dialog box function's call to the DialogBox function failed. For example, this error occurs if the common dialog box call specifies an invalid window handle." : EndCase
         Case 0x0006 : code$ = "!The common dialog box function failed to find a specified resource." : EndCase
         Case 0x0004 : code$ = "!The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding instance handle." : EndCase
         Case 0x0002 : code$ = "!The common dialog box function failed during initialization. This error often occurs when sufficient memory is not available." : EndCase
         Case 0x000B : code$ = "!The ENABLEHOOK flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a pointer to a corresponding hook procedure." : EndCase
         Case 0x0008 : code$ = "!The common dialog box function failed to lock a specified resource." : EndCase
         Case 0x0003 : code$ = "!The ENABLETEMPLATE flag was set in the Flags member of the initialization structure for the corresponding common dialog box, but you failed to provide a corresponding template." : EndCase
         Case 0x0007 : code$ = "!The common dialog box function failed to load a specified string." : EndCase
         Case 0x0001 : code$ = "!The lStructSize member of the initialization structure for the corresponding common dialog box is invalid." : EndCase
         Case 0x0005 : code$ = "!The common dialog box function failed to load a specified string." : EndCase
         Case 0x3003 : code$ = "!The buffer pointed to by the lpstrFile member of the OPENFILENAME structure is too small for the file name specified by the user. The first two bytes of the lpstrFile buffer contain an integer value specifying the size, in TCHARs, required to receive the full name." : EndCase
         Case 0x0009 : code$ = "!The common dialog box function was unable to allocate memory for internal structures." : EndCase
         Case 0x3002 : code$ = "!A file name is invalid." : EndCase
         Case 0x000A : code$ = "!The common dialog box function was unable to lock the memory associated with a handle." : EndCase
         Case 0x3001 : code$ = "!An attempt to subclass a list box failed because sufficient memory was not available." : EndCase
         Case Default : code$ = "!WHOOPS!" : EndCase
      EndSelect
   EndIF

   Delete DLL comdlg32

EndFunction code$



Function _get_str_ptr(pstr As String)
   `pstr$ should be a "|" ( NULL ) seperated string.

   memnum As Integer
   strlen As Integer
   char As Byte
   memptr As DWord
   strptr As DWord

   memnum = _find_free_mem()
   strlen = Len(pstr)

   Make MemBlock memnum,strlen

   For i = 1 To strlen
      If Mid$(pstr,i) = "|"
         char = 0
      Else
         char = Asc(Mid$(pstr,i))
      EndIf
      Write MemBlock Byte memnum,(i - 1),char
   Next i

   memptr = Get MemBlock Ptr(memnum)

   strptr = Make Memory(strlen)

   Copy Memory strptr,memptr,strlen

   Delete MemBlock memnum


EndFunction strptr



Function _get_str(strptr As DWord,strsize As Integer)
   `strptr is the pointer returned by _get_str_ptr()
   `strsize is the Integer length of the string specified by the pointer

   memnum As Integer
   memptr As DWord
   str As String
   char As String

   memnum = _find_free_mem()

   Make MemBlock memnum,strsize

   memptr = Get MemBlock Ptr(memnum)

   Copy Memory memptr,strptr,strsize

   For i = 1 To strsize
      str = str + Chr$(MemBlock Byte(memnum,i - 1))
   Next i

EndFunction str



Function _find_fee_dll()
   retval = 0
   Repeat
      Inc retval
   Until DLL Exist(retval) = 0
EndFunction retval



Function _find_free_mem()
   retval = 50
   Repeat
      Inc retval
   Until MemBlock Exist(retval) = 0
EndFunction retval

sync on
sync rate  400
set text font "Fixedsys",1
font$="Fixedsys"
set text size 20
global dim folder$(600)
global dropdown
global t
global replace
global add
global cut
global coppy
global fontnumber
global keypress$
global menuscroll
global font$
fontnumber=1
global paste
global scroll3
add=3
wrap=15
cls
color backdrop rgb(100,100,100)
dim letter$(100000)
dim letter2$(100000,1)
dim hilighting(100000)
dim coppy$(1000)
syn=5
set image colorkey 255,0,255
ink rgb(255,0,255),rgb(255,0,255)
box 0,0,10,20
ink 0,0
line 5,0,5,20
line 0,0,10,0
line 0,20,10,20
get image 1,0,0,10,21
gosub fontfacing
backspace=200
keypress$=""
lastchar=(screen width()-400)/text width("a")
oldcursor=0
cursor=0
set window size 800,600
do
   gosub autosave
   main:
   scroll2=mousemovez()/120
   spacebar=spacekey()
   backkey=keystate(14)
   theight=text height("a")
   scroll=scroll+scroll2*theight+scroll3*theight
   cursor=cursor-lastchar*(scroll3+scroll2)
   if cursor>i
      for j=i to cursor
          letter$(j)=" "
      next j
      i=cursor
   endif
   scroll3=0
   if scroll>0 then scroll=0
   twidth=text width("a")
   lastrow=scroll+650
   keypress$=entry$()
   clear entry buffer
   if asc(keypress$)>32 and spacebar=1 then goto nocheck
   write:
   if keypress$=key$
      if keypress$=""
      else
         held=held+1
         if held>750
            letter$(cursor)=letter$(cursor)+keypress$
            wait 5
            i=i+1
            cursor=cursor+1
            oldcursor=cursor
            if cursor<i
               for j=i to cursor step -1
                  letter$(j+1)=letter$(j)
               next j
            endif
         endif
      endif
   else
      held=0
      a=asc(keypress$)
      if a>32
         if cursor<i
            for j=i to cursor step -1
               letter$(j+1)=letter$(j)
            next j
         endif
         letter$(cursor)=keypress$
         i=i+1
         cursor=cursor+1
         oldcursor=cursor
      endif
   endif
   nocheck:
   if asc(keypress$)>32
      key$=keypress$
   else
      key$=""
   endif
   if spacebar=1 then key$=" "
   if spacebar=1 and spaceagain=0
      if i>cursor
         for j=i to cursor step -1
               letter$(j+1)=letter$(j)
         next j
         spaceagain=1
         letter$(cursor)=" "
         i=i+1
         cursor=cursor+1
         oldcursor=cursor
      else
         spaceagain=1
         letter$(cursor)=" "
         i=i+1
         cursor=cursor+1
         oldcursor=cursor
      endif
   endif
   if spacebar=0 then spaceagain=0
   if returnkey()=1
      row=cursor/lastchar
      newcursor=(row+1)*lastchar
      differencecursor=newcursor-cursor
      cursor=newcursor
      oldcursor=cursor
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      else
         i=i+differencecursor
      endif
      wait 200
   endif
   if cursorchange>0
      if backkey=1 and back=0 and i>0
         if cursor>oldcursor
            bakspace:
            for j=oldcursor to i
               letter$(j)=letter$(j+cursorchange)
            next j
            for j=i-cursorchange to i
               letter$(j)=""
            next j
            cursor=cursor-cursorchange
            oldcursor=cursor
            i=i-cursorchange
            if i<0 then i=0
            if cursor<0 then cursor=0
            cursorchange=0
            back=1
            wait 200
         endif
         if cursor<oldcursor
            for j=cursor to i
               letter$(j)=letter$(j+cursorchange)
            next j
            for j=i-cursorchange to i
               letter$(j)=""
            next j
            oldcursor=cursor
            i=i-cursorchange
            cursorchange=0
            back=1
            wait 200
         endif
      endif
   endif
   if backkey=1 and i>0 and cursor>0 and back=0 or backspace<1 and i>0 and cursor>0
      back=1
      i=i-1
      cursor=cursor-1
      oldcursor=cursor
      letter$(cursor)=""
      if cursor<i
         for j=cursor to i
            letter$(j)=letter$(j+1)
         next j
      endif
   endif

   if backkey=1 then backspace=backspace-1
   if backkey=0 then backspace=75:back=0
   if controlkey()=1 then ctrl=1
   if controlkey()=0 then ctrl=0
   if ctrl=1 and keystate(45)=1
   cut:
      cop=0
      if oldcursor>cursor then c1=cursor:c2=oldcursor
      if oldcursor<cursor then c2=cursor:c1=oldcursor
      clipcop$=""
      for j=c1 to c2-1
         coppy$(cop)=letter$(j)
         clipcop$=clipcop$+coppy$(cop)
         cop=cop+1
      next j
      write to clipboard clipcop$
      for j=c2 to i
         letter$(j-cop)=letter$(j)
         if j>i-cop then letter$(j)=""
      next j
      i=i-cop
      if i<0 then i=0
      cursor=cursor-cop
      if cursor<0 then cursor=0
      wait 200
   endif
   cut=0
   if ctrl=1 and keystate(46)=1
      coppy:
      cop=0
      if oldcursor>cursor then c1=cursor:c2=oldcursor
      if oldcursor<cursor then c2=cursor:c1=oldcursor
      clipcop$=""
      for j=c1 to c2-1
         coppy$(cop)=letter$(j)
         clipcop$=clipcop$+coppy$(cop)
         cop=cop+1
      next j
      write to clipboard clipcop$
      wait 200
   endif
   coppy=0
   if ctrl=1 and keystate(47)=1
   paste:
      paste$=get clipboard$()
      paste1=len(paste$)
      for j=1 to paste1
         if 32>asc(mid$(paste$,j))
            ri$=right$(paste$,paste1-j-1)
            le$=left$(paste$,j-1)
            paste$=le$+ri$
            ri$=""
            le$=""
            paste1=len(paste$)
         endif
      next j
      paste1=len(paste$)
      for j=i to cursor step -1
         letter$(j+paste1)=letter$(j)
      next j
      for j=cursor to cursor+paste1-1
         letter$(j)=mid$(paste$,j-cursor+1)
      next j
      cursor=cursor+len(paste$)
      i=i+len(paste$)
      wait 200
      paste1=0
   endif
   paste=0

   if syn=0

      cls rgb(100,100,100)
   ink rgb(255,255,255),rgb(255,255,255)
   box 100,50,700,800
      colum=colum+twidth
      wrap=wrap-1
      if wrap=0
         gosub checkforwrap
         wrap=30
      endif
      gosub movecursor
      if mouseclick()=1 then gosub checkmouse
      if mouseclick()=1
         mousehold=1
         if mouseclic>0 then mousehold=2
      else
         if mousehold=1 then mouseclic=10
         mousehold=0
      endif
      if mouseclic>0 then mouseclic=mouseclic-1
      ink 0,rgb(255,255,255)
      for j=0 to i
         column=j*twidth
         row=column/(screen width()-400)
         column=column-row*(screen width()-400)
         if row*theight+scroll>-20 and row*theight+scroll<700
            ink val(letter2$(j,1)),rgb(255,255,255)
            if hilighting(j)=1 then ink val(letter2$(j,1)),rgb(0,0,255)
            text column+200,row*theight+150+scroll,letter$(j)
            if letter2$(j,0)="1" and asc(letter$(j))>64 or letter2$(j,0)="5" and asc(letter$(j))>64 then paste image asc(letter$(j)),column+200,row*theight+150+scroll-1
            if letter2$(j,0)="2" and asc(letter$(j))>64 or letter2$(j,0)="6" and asc(letter$(j))>64 then paste image asc(letter$(j))*4,column+200,row*theight+150+scroll-1
            if letter2$(j,0)="3" and asc(letter$(j))>64 or letter2$(j,0)="7" and asc(letter$(j))>64 then paste image asc(letter$(j))*8,column+200,row*theight+150+scroll-1
            if letter2$(j,0)="4" and asc(letter$(j))>64 or letter2$(j,0)="5" or letter2$(j,0)="6" or letter2$(j,0)="7" then line column+200,row*theight+150+scroll+theight-2,column+200+twidth,row*theight+150+scroll+theight-2
            ink 0,rgb(255,255,255)
         endif
      next j
      ink rgb(200,200,200),rgb(200,200,200)
      box 0,0,800,21
      menu("FILE",200,0,250,21,1,9,0)
      menu("EDIT",250,0,300,21,2,9,0)
      menu("FONTS",650,0,800,21,3,21,0)
      menu("Special Chars.",0,0,200,21,4,200,1)
      button("/\",760,520,800,560,11)
      button("\/",760,560,800,600,12)
      button("COLOR",600,0,650,21,36)
      row2=(cursor*twidth)/(screen width()-400)
      paste image 1,(cursor*twidth)-row2*(screen width()-400)+200-(twidth/2),row2*theight+150+scroll,1
      fastsync
      cls rgb(100,100,100)
      syn=5

   endif
   if syn>0 then syn=syn-1
   if search=1 then goto insearch
loop


checkforwrap:
   for j=1 to i/lastchar
      if asc(letter$(lastchar*j))>32
         for k=lastchar*j to ((lastchar*(j-1)))+1 step -1
            if letter$(k)=" " then firstchar=k: goto checknext
         next k
         goto nowrap
         checknext:
         for k=i to firstchar step -1
            letter$((lastchar*j)-firstchar+(k)-1)=letter$(k)
         next k
         i=i+(lastchar*j)-firstchar
         if cursor=(lastchar*j) or cursor=(lastchar*j)+1 then cursor=cursor+(lastchar*j)-firstchar+1:oldcursor=cursor
         for k=firstchar to lastchar*j-1
            letter$(k)=" "
         next k
      endif
      nowrap:
   next j
return

movecursor:
   if shift=0
      if rightkey()=1  and cursor<i
         cursor=cursor+1:oldcursor=cursor:cursorchange=abs(cursor-oldcursor):wait 100
         for j=0 to i
            hilighting(j)=0
         next j
      endif
      if leftkey()=1  and cursor>0
         cursor=cursor-1:oldcursor=cursor:cursorchange=abs(cursor-oldcursor):wait 100
         for j=0 to i
            hilighting(j)=0
         next j
      endif
      if upkey()=1 and cursor>lastchar
         cursor=cursor-lastchar:wait 100
         oldcursor=cursor:cursorchange=abs(cursor-oldcursor)
         for j=0 to i
            hilighting(j)=0
         next j
      endif
      if downkey()=1 and cursor<i-lastchar+1
         cursor=cursor+lastchar:wait 100
         oldcursor=cursor:cursorchange=abs(cursor-oldcursor)
         for j=0 to i
            hilighting(j)=0
         next j
      endif
   endif
   if shiftkey()=1 and shift=1 then shift=2
   if shiftkey()=1 and shift=0 then shift=1
   if shiftkey()=0 then shift=0
   if shift=2
      for j=0 to i
          hilighting(j)=0
      next j
      if rightkey()=1  and cursor<i then cursor=cursor+1:wait 100
      if leftkey()=1  and cursor>0 then cursor=cursor-1:wait 100
      if downkey()=1 and cursor<i-lastchar+1 then cursor=cursor+lastchar:wait 100
      if upkey()=1 and cursor>lastchar then cursor=cursor-lastchar:wait 100
         if cursor<oldcursor
            for j=cursor to oldcursor-1
               hilighting(j)=1
            next j
            cursorchange=abs(cursor-oldcursor)
         endif
         if cursor>oldcursor
            for j=cursor-1 to oldcursor step -1
               hilighting(j)=1
            next j
            cursorchange=abs(cursor-oldcursor)
         endif
   endif
return

checkmouse:
   if mousey()<100 then goto nomovecursor
   if mousehold=0 or mousehold=2
      x=(mousex()-200)/twidth
      y=(mousey()-150-scroll)/theight
      if mousex()<200 or mousex()>screen width()-200 or mousey()<140 then goto nomovecursor
      cursor=y*((screen width()-400)/twidth)+x
      oldcursor=cursor
      for j=0 to i
          hilighting(j)=0
      next j
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      endif
   endif
   if mousehold=1
      for j=1 to i
          hilighting(j)=0
      next j
      x=(mousex()-200)/twidth
      y=(mousey()-150-scroll)/theight
      if mousex()<200 or mousex()>screen width()-200 or mousey()<140 then goto nomovecursor
      cursor=y*((screen width()-400)/twidth)+x
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      endif
      if cursor<oldcursor
         for j=cursor to oldcursor-1
            hilighting(j)=1
         next j
      endif
      if cursor>oldcursor
         for j=cursor-1 to oldcursor step -1
            hilighting(j)=1
         next j
      endif
   endif
   if mousehold=2
      if cursor>i
         for j=i to cursor
            letter$(j)=" "
         next j
         i=cursor
      endif
      h=cursor
      repeat
         h=h-1
      until letter$(h)=" " or letter$(h)="" or h=0
      oldcursor=h
      repeat
         h=h+1
      until letter$(h)=" " or letter$(h)=""
      cursor=h
      for j=cursor-1 to oldcursor step -1
         hilighting(j)=1
      next j
   endif
   cursorchange=abs(cursor-oldcursor)
   nomovecursor:
return



function button(caption$,left,top,right,bottom,number)
   ink 0,rgb(200,200,200)
   if mousex()>left and mousey()>top and mousex()<right and mousey()<bottom then inside=1
   if inside=1 then ink 0,rgb(0,0,200)
   if number<40 or number>200 then center text left+(right-left)/2,top+(bottom-top)/2-10,caption$
   if number>39 and number<200 then center text left+(right-left)/2,top+(bottom-top)/2-10,chr$(val(caption$))
   if inside=1 and mouseclick()=1
      if number=1 then gosub save
      if number=2 then gosub load
      if number=3 then end
      if number=4 then goto cut
      if number=5 then goto coppy
      if number=6 then goto paste
      if number=7 then gosub bold
      if number=8 then gosub Italics
      if number=9 then gosub normal
      if number=10 then gosub underline
      if number=11 then scroll3=1:wait 100
      if number=12 then scroll3=-1:wait 100
      if number=13 then gosub export
      if number=14 then gosub prin
      if number>14 and number<36
         if number>16 and number<25 or number>31 and number<35
            fontnumber=number-13
            set text font caption$,1
            set text size 20
            gosub fontfacing
            font$=caption$
         else
            fontnumber=number-13
            set text font caption$,255
            set text size 20
            gosub fontfacing
            font$=caption$
         endif
      endif
      if number=35
         fontnumber=number-13
         set text font caption$,1
         set text size 20
         gosub fontfacing
         font$=caption$
      endif
      if number=36 then gosub collor
      if number=37 then gosub upper
      if number=38 then gosub lower
      if number=39 then gosub definition
      if number>39 and number<200
         keypress$=chr$(val(caption$))
         goto write
      endif
      if number=201 then gosub search
      if number=202 then replace=1:gosub search
      if number=203 then replace=1:gosub unifyspaces
   endif
   ink 0,rgb(255,255,255)
endfunction

function menu(caption$,left,top,right,bottom,number,numofbuttons,scroll)
   ink 0,rgb(200,200,200)
   if mousex()>left and mousey()>top and mousex()<right and mousey()<bottom and mouseclick()=1 then dropdown=number
   if dropdown=number then ink 0,rgb(0,0,200)
   center text left+(right-left)/2,top+(bottom-top)/2-10,caption$
   ink 0,rgb(255,255,255)
      if dropdown=number
         if number=1 then restore m1
         if number=2 then restore m2
         if number=3 then restore m3
         if number=4 then restore m4
         if scroll=1
            if downkey()=1 then menuscroll=menuscroll+1
            if upkey()=1 then menuscroll=menuscroll-1
         for k=1 to menuscroll
            read a$
            read b
         next k
         endif

         for i=1 to numofbuttons
         read a$
         read b
         button(a$,left,bottom*i,right,bottom*(i+1),b)
         next i
         if (numofbuttons+1)*bottom <mousey() or  mousey()<top or mousex()>right or mousex()<left then dropdown=0
      endif
      back:
endfunction

Bold:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      if letter2$(j,0)="2" then letter2$(j,0)="3"
      if letter2$(j,0)="3" then goto nextbold
      if letter2$(j,0)="4" then letter2$(j,0)="5"
      if letter2$(j,0)="5" then goto nextbold
      if letter2$(j,0)="6" then letter2$(j,0)="7"
      if letter2$(j,0)="7" then goto nextbold
      letter2$(j,0)="1"
      nextbold:
   next j
return

Italics:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      if letter2$(j,0)="1" then letter2$(j,0)="3"
      if letter2$(j,0)="3" then goto nextitalics
      if letter2$(j,0)="4" then letter2$(j,0)="6"
      if letter2$(j,0)="6" then goto nextitalics
      if letter2$(j,0)="5" then letter2$(j,0)="7"
      if letter2$(j,0)="7" then goto nextitalics
      letter2$(j,0)="2"
      nextitalics:
   next j
return

Underline:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      if letter2$(j,0)="1" then letter2$(j,0)="5"
      if letter2$(j,0)="5" then goto nextunderline
      if letter2$(j,0)="2" then letter2$(j,0)="6"
      if letter2$(j,0)="6" then goto nextunderline
      if letter2$(j,0)="3" then letter2$(j,0)="7"
      if letter2$(j,0)="7" then goto nextunderline
      letter2$(j,0)="4"
      nextunderline:
   next j
return

Unifyspaces:
   for j=0 to i
      if letter$(j)=" " then space=space+1
      if asc(letter$(j))>32 and space>1
         for h=j to i
            letter$(h-space+1)=letter$(h)
            if letter$(h-space+1)="" then letter$(h-space+1)=" "
         next h
         i=i-space+1
         space=0
      endif
      if asc(letter$(j))>32 then space=0
   next j
return

search:
   ink 0,rgb(255,255,255)
   search=1
   text 0,0,"Input the search item"
   set cursor 0,20
   input search$
   wait 250
   if replace=1
      text 0,40,"Input the replace item"
      set cursor 0,60
      input replac$
      wait 100
   endif
   clear entry buffer
   searchlength=len(search$)
   search$=lower$(search$)
   firstcharofsearch$=mid$(search$,1)
   for j=0 to i
      searchj=j
      if lower$(letter$(j))=firstcharofsearch$
         for k=2 to searchlength
            if mid$(search$,k)=lower$(letter$(j+k-1))
            else
               goto stopwordsearch
            endif
         next k
         oldcursor=j
         cursor=j+searchlength
         cursorchange=abs(cursor-oldcursor)
         for k=0 to searchlength-1
            hilighting(k+j)=1
         next k
         do
         goto main
         insearch:
         if returnkey()=1 or wordreplace=1 then wait 500:clear entry buffer:goto stopwordsearch
         if mouseclick()=1 then text 0,0,"search aborted":sync:wait 500:goto quitsearch
         if mouseclick()=2 and replace=1 then wait 250: gosub replace
         loop
         stopwordsearch:
         for k=0 to i
            hilighting(k)=0
         next k
      endif
      j=searchj
   next j
   text 0,0,"search finished"
   sync
   wait 500
   quitsearch:
   search=0
   replace=0
   cursorchange=0
   oldcursor=cursor
return

replace:
   replacelength=len(replac$)
   differencelength=searchlength-replacelength
   if differencelength<0
      for h=i to cursor step -1
         letter$(h-differencelength)=letter$(h)
      next h
   endif
   if differencelength>0
      for h=cursor to i
         letter$(h-differencelength)=letter$(h)
      next h
   endif
   for h=oldcursor to oldcursor+replacelength-1
      letter$(h)=mid$(replac$,h-oldcursor+1)
   next h
   for h=i to i-differencelength
      letter$(h)=" "
   next h
   i=i-differencelength
   goto stopwordsearch
return

Normal:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      letter2$(j,0)="0"
   next j
return

save:
   if len(save$)>0 then goto save2
   ink 0,rgb(255,255,255)
   cls
   sync
   text 0,0,"Save as: "
   input "Save as: ",save$
   clear entry buffer
   save2:
   save array save$+".spopovichtext",letter$(100000)
   letter2$(100000,1)=str$(i)
   letter2$(100000,0)=str$(cursor)
   save array save$+".spopovichformating",letter2$(100000,1)
return

load:
   ink 0,rgb(255,255,255)
   cls
   text 0,0,"Load: "
   sync
   input "Load: ",save$
   clear entry buffer
   load array save$+".spopovichtext",letter$(100000)
   load array save$+".spopovichformating",letter2$(100000,1)
   i=val(letter2$(100000,1))
   cursor=val(letter2$(100000,0))
   clear entry buffer
return

export:
   ink 0,rgb(255,255,255)
   cls
   sync
   text 0,0,"Export as: "
   input "Export as: ",save$
   open to write 1,save$+".txt"
   for j=0 to i
      line$=line$+letter$(j)
      lin=lin+1
      if lin=40
         write string 1,line$
         line$=""
         lin=0
      endif
   next j
   write string 1,line$
   close file 1
   clear entry buffer
return


upper:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      letter$(j)=upper$(letter$(j))
   next j
return

lower:
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      letter$(j)=lower$(letter$(j))
   next j
return

collor:
   ink 0,rgb(255,255,255)
   sync
   repeat
   r$=r$+(inkey$())
   if keystate(14)=1 then r$=left$(r$,len(r$)-2)
   cls
   text 0,20,r$
   text 0,0,"red amount"
   sync
   wait 100
   until returnkey()=1
   r=val(r$)
   sync
   sync
   repeat
   g$=g$+(inkey$())
   if keystate(14)=1 then g$=left$(g$,len(g$)-2)
   text 0,60,g$
   text 0,40,"green amount"
   sync
   wait 100
   until returnkey()=1
   g=val(g$)
   sync
   repeat
   b$=b$+(inkey$())
   if keystate(14)=1 then b$=left$(b$,len(b$)-2)
   text 0,100,b$
   text 0,80,"blue amount"
   sync
   wait 100
   until returnkey()=1
   b=val(b$)
   sync
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   color=(rgb(r,g,b))
   color$=str$(color)
   color$=right$(color$,len(color$)-1)
   for j=c1 to c2-1
      letter2$(j,1)=color$
   next j
   clear entry buffer
return

prin:
   open to write 5,"print.html"
   write string 5,"<html>"
   write string 5,"<title>Print Prievew</title>"
   write string 5,"<body>"
   write string 5,"<div align="+chr$(34)+"center"+chr$(34)+">"
   write string 5,"<font size="+chr$(34)+"10"+chr$(34)+" face="+chr$(34)+font$+chr$(34)+">"
   write string 5,save$
   if save$="" then write string 5,"Untitled <br></div>"
   write string 5,"<div align="+chr$(34)+"left"+chr$(34)+">"
   for j=0 to i
      if letter2$(j,0)="1" and bol=0 or letter2$(j,0)="5" and bol=0 then line$=line$+"<b>":bol=1:goto notnormal
      if letter2$(j,0)="2" and ital=0 or letter2$(j,0)="6" and ital=0 then line$=line$+"<i>":ital=1:goto notnormal
      if bol=1 then line$=line$+"</b>":bol=0
      if ital=1 then line$=line$+"</i>":ital=0
      notnormal:
      line$=line$+letter$(j)
      brake=brake+1
      if brake=80 then brake=0:write string 5,line$:line$="":write string 5,"<br>"
   next j
   if bol=1 then line$=line$+"</b>"
   if ital=1 then line$=line$+"</i>"
   write string 5,"</font>"
   write string 5,"</div>"
   write string 5,"</body>"
   write string 5,"</html>"
   close file 5
   execute file "print.html","","",1
   suspend for mouse
   delete file "print.html"
   bol=0
   ital=0
   brake=0
return

autosave:
   if timer()>savetime+300000 and len(save$)>0 then savetime=timer():text 0,0,"Autosaving":sync: goto save2
return

definition:
   word$=""
   if oldcursor>cursor then c1=cursor:c2=oldcursor
   if oldcursor<cursor then c2=cursor:c1=oldcursor
   for j=c1 to c2-1
      word$=word$+letter$(j)
   next j
   execute file "C:\Program Files\Internet Explorer\iexplore.exe","http://dictionary.reference.com/search?q="+word$,""
return

fontfacing:
   add=3
   cls
   ink 0,rgb(255,255,255)
   cls rgb(255,255,255)
   sync
   set text to bold
   width=text width("a")
   height=text height("A")
   for j=65 to 90
   text 0,fontnumber*20,"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   sync
   get image j,(j-65)*width,fontnumber*20,(j-64)*width,fontnumber*20+20
   next j
   cls rgb(255,255,255)
   sync
   cls rgb(255,255,255)
   text 0,fontnumber*20,"abcdefghijklmnopqrstuvwxyz"
   sync
   for j=97 to 122
   get image j,(j-97)*width,fontnumber*20,(j-96)*width,fontnumber*20+20
   next j
   ink 0,rgb(255,255,255)
   set text to italic
   ink 0,rgb(255,255,255)
   cls rgb(255,255,255)
   sync
   width=text width("a")
   text 0,fontnumber*20,"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   sync
   for j=65 to 90
   get image j*4,(j-65)*width+width/2-2,fontnumber*20,(j-64)*width+width/2-2,fontnumber*20+20
   next j
   cls rgb(255,255,255)
   text 0,fontnumber*20,"abcdefghijklmnopqrstuvwxyz"
   sync
   for j=97 to 122
   get image j*4,(j-97)*width+width/2-2,fontnumber*20,(j-96)*width+width/2-2,fontnumber*20+20
   next j
   ink 0,rgb(255,255,255)
   box 0,0,10,20
   set text to bolditalic
   ink 0,rgb(255,255,255)
   cls rgb(255,255,255)
   sync
   width=text width("a")
   text 0,fontnumber*20,"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   sync
   for j=65 to 90
   get image j*8,(j-65)*width+width/2-2,fontnumber*20,(j-64)*width+width/2-2,fontnumber*20+20
   next j
   cls rgb(255,255,255)
   text 0,fontnumber*20,"abcdefghijklmnopqrstuvwxyz"
   sync
   for j=97 to 122
   get image j*8,(j-97)*width+width/2-2,fontnumber*20,(j-96)*width+width/2-2,fontnumber*20+20
   next j
   ink 0,rgb(255,255,255)
   set text to normal
   set text opaque
return

m1:
data "Save",1
data "Load",2
data "Definition",39
data "Find",201
data "Replace",202
data "Unify spaces",203
data "Export",13
data "print",14
data "Exit",3
return
m2:
data "Cut",4
data "Copy",5
data "Paste",6
data "Bold",7
data "Italics",8
data "Normal",9
data "Undeline",10
data "Uppercase",37
data "Lowercase",38
return
m3:
data "Lucida Console",15
data "Impact",16
data "AvantGarde Bk BT",17
data "Swiss911 XCm BT",18
data "WP BoxDrawing",19
data "Cuckoo",20
data "Tristan",21
data "Aurora Cn BT",22
data "Informal011 BT",23
data "Unicorn",24
data "MS Mincho",25
data "MS Gothic",26
data "GulimChe",27
data "DotumChe",28
data "BatangChe",29
data "Gungsuh",30
data "GungsuhChe",31
data "SimSun",32
data "NSimSun",33
data "MingLiU",34
data "Fixedsys",35
m4:
data "123",163
data "124",162
data "125",161
data "126",160
data "127",159
data "128",158
data "129",157
data "130",156
data "131",130
data "132",131
data "133",132
data "134",133
data "135",134
data "136",135
data "137",136
data "138",137
data "139",138
data "140",139
data "141",140
data "142",141
data "143",142
data "144",143
data "145",144
data "146",145
data "147",146
data "148",147
data "149",148
data "150",149
data "151",150
data "152",151
data "153",152
data "154",153
data "159",154
data "160",155
data "161",104
data "162",105
data "163",106
data "164",107
data "165",108
data "171",109
data "172",110
data "173",111
data "174",112
data "175",113
data "176",114
data "177",115
data "178",116
data "179",117
data "180",118
data "181",119
data "182",120
data "183",121
data "184",122
data "185",123
data "186",124
data "187",125
data "188",126
data "189",127
data "190",128
data "191",129
data "192",40
data "193",41
data "194",42
data "195",43
data "196",44
data "197",45
data "198",46
data "199",47
data "200",48
data "201",49
data "202",50
data "203",51
data "204",52
data "205",53
data "206",54
data "207",55
data "208",56
data "209",57
data "210",58
data "211",59
data "212",60
data "213",61
data "214",62
data "215",63
data "216",64
data "217",65
data "218",66
data "219",67
data "220",68
data "221",69
data "222",70
data "223",71
data "224",72
data "225",73
data "226",74
data "227",75
data "228",76
data "229",77
data "230",78
data "231",79
data "232",80
data "233",81
data "234",82
data "235",83
data "236",84
data "237",85
data "238",86
data "239",87
data "240",88
data "241",89
data "242",90
data "243",91
data "244",92
data "245",93
data "246",94
data "247",95
data "248",96
data "249",97
data "250",98
data "251",99
data "242",100
data "243",101
data "254",102
data "255",103

PHAELAX!

A very impressive text editor, fairly robust text selection, nice windows environment, good text scrolling, and saving/loading normal text files all make this text editor exceptionally fun to learn and easy to use.
Well Done!

`tex=text
`b=bold
`i=italics
`l=linebrake
`head=heading
`lin=link part 1 name part 2 link name
`unorderedlist
`lude=include in list
`font=size,color,face
`ima=image adress,alt text,align
`bod=body must be first! background tile,background color,text color,unfallowed link color,activated link color, unfallowed link color



input name$
open to write 1,name$+".html"
#constant tex=0
#constant B=1
#constant i=2
#constant l=3
#constant head=4
#constant lin=5
#constant lef=6
#constant righ=7
#constant cente=8
#constant unorderedlist=9
#constant item=10
#constant stoplist=11
#constant orderedlist=12
#constant fon=13
#constant ima=14
#constant bod=15
quotes$=chr$(34)

write string 1,"<html>"
write string 1,"<body>"

for j=1 to 12
read a,a$,c$
if a=0 then write string 1,a$
if a=1 then write string 1,"<b>"+a$+"</b>"
if a=2 then write string 1,"<i>"+a$+"</i>"
if a=3 then write string 1,"<br>"
if a=4 then write string 1,"<h1>"+a$+"</h1>"
if a=5 then write string 1,"<a href="+c$+">"+a$+"</a>"
if 1=dif and a=6 or a=7 or a=8 then write string 1,"</div>"
if a=6 then write string 1,"<div align="+quotes$+"left"+quotes$+">":dif=1
if a=7 then write string 1,"<div align="+quotes$+"right"+quotes$+">":dif=1
if a=8 then write string 1,"<div align="+quotes$+"center"+quotes$+">":dif=1

if a=9 then write string 1,"<ul>":list=1
if a=12 then write string 1,"<ol>":list=2
if a=10 then write string 1,"<li>"+a$
if a=11 and list=1 then write string 1,"</ul>":list=0
if a=11 and list=2 then write string 1,"</ol>":list=0
if a=13
   size$=quotes$
   for k=1 to len(a$)
      if mid$(a$,k)="," then term=term+1
      if term=0 then size$=size$+mid$(a$,k)
      if term=1 then color$=color$+mid$(a$,k)
      if term=2 then face$=face$+mid$(a$,k)
   next k
   face$=right$(face$,len(face$)-1)
   color$=right$(color$,len(color$)-1)
   face$=quotes$+face$
   color$=quotes$+color$
   size$=size$+quotes$
   face$=face$+quotes$
   color$=color$+quotes$
   term=0
   write string 1,"<font size="+size$+" color="+color$+" face="+face$+" >"
   font=1
   size$=""
   face$=""
   color$=""
endif
if a=14
   size$=quotes$
   for k=1 to len(a$)
      if mid$(a$,k)="," then term=term+1
      if term=0 then size$=size$+mid$(a$,k)
      if term=1 then color$=color$+mid$(a$,k)
      if term=2 then face$=face$+mid$(a$,k)
   next k
   face$=right$(face$,len(face$)-1)
   color$=right$(color$,len(color$)-1)
   face$=quotes$+face$
   color$=quotes$+color$
   size$=size$+quotes$
   face$=face$+quotes$
   color$=color$+quotes$
   term=0
   write string 1,"<img src="+size$+" alt="+color$+" align="+face$+" >"
   size$=""
   face$=""
   color$=""
endif
if a=15 and body=0
   size$=quotes$
   for k=1 to len(a$)
      if mid$(a$,k)="," then term=term+1
      if term=0 then size$=size$+mid$(a$,k)
      if term=1 then color$=color$+mid$(a$,k)
      if term=2 then face$=face$+mid$(a$,k)
      if term=3 then size2$=size2$+mid$(a$,k)
      if term=4 then color2$=color2$+mid$(a$,k)
      if term=5 then face2$=face2$+mid$(a$,k)
   next k
   face$=right$(face$,len(face$)-1)
   color$=right$(color$,len(color$)-1)
   size2$=right$(size2$,len(size2$)-1)
   color2$=right$(color2$,len(color2$)-1)
   face2$=right$(face2$,len(face2$)-1)
   face$=quotes$+face$
   color$=quotes$+color$
   face2$=quotes$+face2$
   color2$=quotes$+color2$
   aize2$=quotes$+size2$
   size$=size$+quotes$
   face$=face$+quotes$
   color$=color$+quotes$
   size2$=size2$+quotes$
   face2$=face2$+quotes$
   color2$=color2$+quotes$
   term=0
   write string 1,"<body BACKGROUND="+size$+" BGCOLOR="+color$+" TEXT="+face$+" LINK="+size2$+" ALINK="+color2$+" VLINK="+face2$+" >"
   body=1
   size$=""
   face$=""
   color$=""
   size2$=""
   face2$=""
   color2$=""
endif
if body=0 then write string 1,"<body>":body=1
next j


if font=1 then write string 1,"</font>"
if dif=1 then write string 1,"</div>"
write string 1,"</body>"
write string 1,"</html>"
close file 1
end

`tex=text
`b=bold
`i=italics
`l=linebrake
`head=heading
`lin=link part 1 name part 2 link name
`unorderedlist
`lude=include in list
`font=size,color,face
`ima=image adress,alt text,align
`bod=body must be first! background tile,background color,text color,unfallowed link color,activated link color, unfallowed link color

data cente,"",""
data head,"This Rowing Season",""
data l,"",""
data b,"Some rowing pictures",""
data ima,"rowing-boat_small.jpg,Rowing People,right",""
data ima,"rotsee-rowing_small.jpg,Rowing People,left",""
data head,"More pictures of rowing",""
data lin,"To more rowing pictures","http://images.google.com/imgres?imgurl=http://www.picture-newsletter.com/rowing/rowing-man.jpg&imgrefurl=http://www.picture-newsletter.com/rowing/index.htm&h=800&w=1200&sz=113&hl=en&start=1&tbnid=UvFdEngwEoJmUM:&tbnh=100&tbnw=150&prev=/images%3Fq%3Drowing%26svnum%3D10%26hl%3Den%26lr%3D%26rls%3DGGGL,GGGL:2006-22,GGGL:en%26sa%3DN"
data l,"",""
data b,"Do you plan on rowing?",""

remstart
data bod,",black,blue,blue,red,purple",""
data cente,"",""
data head,"Welcome to my Web page",""
data fon,"15,blue,arial",""
data l,"",""
data ima,"tn_gokublocking.gif,It's Goku,right",""
data orderedlist,"",""
data item,"this is written in dark basic",""
data item,"eragon is a good book",""
data item,"",""
data head,"section 2",""
data lin,"Google","http://www.google.com"
data stoplist,"",""
remend

REM By Mr Kohlenstoff
REM For the 2D-Physics-Competition
REM Code finished 12.09.06
REM Particle-Simulation
set display mode 800,600,32
set text font "Tahoma"
set text size 14

type Particle
   Xpos as float
   ypos as float
   xmove as float
   ymove as float
   power as byte
endtype

global MinPower = 6
global MaxPower = 12
global SideMove = 4
global TopMove = 18
global Number = 2500
global MaxNumber = Number
global StartNumber = MaxNumber/5

global ParticleGravity = 50

dim Particle(Number) as particle

sync on : sync rate 30
hide mouse

BoxSize = 8 `Größe der Particle-Boxen

for p = 0 to Number
   Particle(p).xpos = rnd(screen width())
   Particle(p).ypos = rnd(screen height())
   Particle(p).xmove = 5-rnd(10)
   Particle(p).ymove = 5-rnd(15)
   Particle(p).power = MinPower + rnd(MaxPower - MinPower)
next p


ink rgb(32,255,64),0
Number = 200


do
   cls
   ink rgb(255,255,255),0
   print "FPS: "+ str$(screen fps())
   print "Particles: "+ str$(Number)
   print "Gravity: " + str$(ParticleGravity)
   print "Energy-Range: " + str$(MinPower) + "-" + str$(MaxPower)
   print "Side-Movement: " + str$(SideMove)
   print "Top-Movement: " + str$(TopMove)
   print "---"
   print "Press Shift- or Controlkey to change the gravity."
   print "Press '-' or '+' to change the Particle-Quantity."
   print "Press Rightkey and Leftkey to change the Side-Movement."
   print "Press Up- and Downkey to change the Top-Movement."
   print "Press 'r' to reset Particle-Positions."
   print "Press '.' or ',' to change the Energy-Range."
   print len(Console$)

   if inkey$()="-" then dec Number, 5
   if inkey$()="+" then inc Number, 5
   if inkey$()="." then inc MinPower : inc MaxPower
   if inkey$()="," then dec MinPower : dec MaxPower
   if Number < 0 then Number = 0
   if Number > MaxNumber then Number = MaxNumber
   inc ParticleGravity, 5*(Shiftkey()-Controlkey())
   inc SideMove, rightkey()-leftkey()
   inc TopMove, upkey()-downkey()
   if inkey$()="r"
      for p = 0 to Number
         Particle(p).xpos = mousex()
         Particle(p).ypos = mousey()
         Particle(p).xmove = SideMove - rnd(SideMove*200)/100.0
         Particle(p).ymove = -rnd(TopMove*100)/100.0
         Particle(p).power = MinPower + rnd(MaxPower - MinPower)
      next p
   endif

   line mousex()-5, mousey(), mousex()+5, mousey()
   line mousex(), mousey()-5, mousex(), mousey()+5



   for p = 0 to Number
      inc Particle(p).ymove,  ParticleGravity/100.0
      inc Particle(p).ypos, Particle(p).ymove
      if Particle(p).xpos => screen width() or Particle(p).xpos <= 0 then Particle(p).xmove = -Particle(p).xmove
      inc Particle(p).xpos, Particle(p).xmove
      if Particle(p).ypos => screen height() then Particle(p).ymove = -Particle(p).ymove* (0.7+rnd(29)/100.0) : dec Particle(p).power
         if abs(Particle(p).power) <= 1
            Particle(p).xpos = mousex()
            Particle(p).ypos = mousey()
            Particle(p).xmove = SideMove - rnd(SideMove*200)/100.0
            Particle(p).ymove = -rnd(TopMove*100)/100.0
            Particle(p).power = MinPower + rnd(MaxPower - MinPower)
         endif
   next p

   lock pixels
      for p = 0 to Number
         R = 200+rnd(55)
         G = rnd(R*0.8)
         B = rnd(G*0.6)

         ink rgb(R, G, B),0

         box Particle(p).xpos, Particle(p).ypos, Particle(p).xpos+BoxSize, Particle(p).ypos+BoxSize
      next p
   unlock pixels

   sync
loop

sync on
sync rate 0
cls
autocam off
position camera 0,0,-100
rotate camera 0,0,0
type xy
   x as float
   y as float
endtype

type xyw
   x as float
   y as float
   w as float
endtype

type body_type
   p as xyw
   v as xyw
   force as xyw
   impulse as xyw
   mass as float
   moi as float
   vertex_amount
   exist as boolean
   gravity as boolean
   active as boolean
   autofreeze as boolean
   object
   lin_damp as float
   ang_damp as float
endtype

global max_body_amount=10
global max_vertex_amount=10
global max_collision_data_amount=10
dim body(max_body_amount) as body_type
dim body_shape(max_body_amount,max_vertex_amount) as xy
type collision_data_type
   vertex_amount
   exist as boolean
endtype
dim collision_data(max_collision_data_amount) as collision_data_type
dim collision_data_v(max_collision_data_amount,max_vertex_amount) as xy
type world_type
   min as xy
   max as xy
   onexit
endtype
type rbd_type
   world as world_type
   last_time
endtype

global RBD as rbd_type
global RBD_V1=1
global RBD_V2=2
global RBD_V3=3
global RBD_V4=4
n=make vector2(RBD_V1)
n=make vector2(RBD_V2)
n=make vector2(RBD_V3)
n=make vector2(RBD_V4)
RBD_Create()
col=RBD_CreateBox(10.0,10.0)
make object plain 1,10.0,10.0
body1=RBD_CreateBody(col)
RBD_BodySetDBProData(body1, 1)

global time# as float
do
   time#=RBD_GetElapsedTimeInSec()
   RBD_Update(time#)
   set cursor 0,0
   print screen fps()
   if mouseclick()=1
      x#=(mousex()-screen width()*0.5)*0.1
      y#=(screen height()*0.5-mousey())*0.1
      set vector2 RBD_V1,x#,y#
      set vector2 RBD_V2,0,20
      RBD_BodyAddForceLocal(body1)
   endif
   sync
loop

function RBD_Create()
   RBD.world.min.x=-100.0
   RBD.world.max.x=100.0
   RBD.world.min.y=-100.0
   RBD.world.max.y=100.0
   RBD.last_time=timer()
   RBD.world.onexit=0
   local b
   for b=0 to max_body_amount
      body(b).exist=0
   next b
endfunction

function RBD_Update(time#)
   for b=0 to max_body_amount
      if body(b).exist=1
         if RBD.world.onexit=1
            if body(b).p.x<RBD.world.min.x or body(b).p.y<RBD.world.min.y or body(b).p.x>RBD.world.max.x or body(b).p.y>RBD.world.max.y then body(b).exist=0
         endif
         body(b).force.x=body(b).force.x-body(b).lin_damp*body(b).v.x*abs(body(b).v.x)*time#
         body(b).force.y=body(b).force.y-body(b).lin_damp*body(b).v.y*abs(body(b).v.y)*time#
         body(b).force.w=body(b).force.w-body(b).ang_damp*body(b).v.w*abs(body(b).v.w)*time#
         body(b).v.x=body(b).v.x+body(b).force.x/body(b).mass*time#+body(b).impulse.x/body(b).mass
         body(b).v.y=body(b).v.y+body(b).force.y/body(b).mass*time#+body(b).impulse.y/body(b).mass
         body(b).v.w=body(b).v.w+body(b).force.w/body(b).moi*time#+body(b).impulse.w/body(b).moi
         body(b).force.x=0
         body(b).force.y=0
         body(b).force.w=0
         body(b).impulse.x=0
         body(b).impulse.y=0
         body(b).impulse.w=0
         body(b).p.x=body(b).p.x+body(b).v.x*time#
         body(b).p.y=body(b).p.y+body(b).v.y*time#
         body(b).p.w=body(b).p.w+body(b).v.w*time#
         if body(b).object>0
            position object body(b).object,body(b).p.x,body(b).p.y,0
            rotate object body(b).object,0,0,body(b).p.w
         endif
      endif
   next b
endfunction

function RBD_GetElapsedTimeInSec()
   t#=(timer()-RBD.last_time)*0.001
   RBD.last_time=timer()
   if t#<0.001 then t#=0.001
endfunction t#

function RBD_SetWorldSize()
   RBD.world.min.x=x vector2(RBD_V1)
   RBD.world.min.y=y vector2(RBD_V1)
   RBD.world.max.x=x vector2(RBD_V2)
   RBD.world.max.y=y vector2(RBD_V2)
endfunction

function RBD_CreateBox(sx#,sy#)
   local c=0
   while collision_data(c).exist=1
      inc c
   endwhile
   collision_data(c).exist=1
   collision_data(c).vertex_amount=4
   collision_data_v(c,0).x=sx#*0.5
   collision_data_v(c,0).y=sy#*0.5
   collision_data_v(c,1).x=sx#*0.5
   collision_data_v(c,1).y=-sy#*0.5
   collision_data_v(c,2).x=-sx#*0.5
   collision_data_v(c,2).y=-sy#*0.5
   collision_data_v(c,3).x=-sx#*0.5
   collision_data_v(c,3).y=sy#*0.5
endfunction c

function RBD_CreateBody(col)
   local b=0
   while body(b).exist=1
      inc b
   endwhile
   body(b).exist=1
   body(b).p.x=0
   body(b).p.y=0
   body(b).p.w=0
   body(b).v.x=0
   body(b).v.y=0
   body(b).v.w=0
   body(b).force.x=0
   body(b).force.y=0
   body(b).force.w=0
   body(b).impulse.x=0
   body(b).impulse.y=0
   body(b).impulse.w=0
   body(b).mass=1
   body(b).moi=1
   body(b).gravity=1
   body(b).active=1
   body(b).autofreeze=1
   body(b).lin_damp=0.1
   body(b).ang_damp=0.1
   body(b).vertex_amount=collision_data(col).vertex_amount
   local v
   for v=0 to body(b).vertex_amount-1
      body_shape(b,v).x=collision_data_v(col,v).x
      body_shape(b,v).y=collision_data_v(col,v).y
   next v
endfunction b

function RBD_DestroyBody(b)
   body(b).exist=0
endfunction

function RBD_BodyGetRotation(b)
   set vector2 RBD_V1,body(b).p.w,0
endfunction

function RBD_BodyGetPosition(b)
   set vector2 RBD_V1,body(b).p.x,body(b).p.y
endfunction

function RBD_DestroyAllBodies()
   local b
   for b=0 to max_body_amount
      RBD_DestroyBody(b)
   next b
endfunction

function RBD_SetBodyLeaveWorldEvent(flag)
   RBD.world.onexit=flag
endfunction

function RBD_BodySetDBProData(body, db_num)
   body(body).object=db_num
endfunction

function RBD_BodySetVelocity(body)
   body(body).v.x=x vector2(RBD_V1)
   body(body).v.y=y vector2(RBD_V1)
endfunction

function RBD_BodyGetVelocity(body)
   set vector2 RBD_V1,body(body).v.x,body(body).v.y
endfunction

function RBD_BodySetOmega(body)
   body(body).v.w=x vector2(RBD_V1)
endfunction

function RBD_BodyGetOmega(body)
   set vector2 RBD_V1,body(body).v.w,0
endfunction

function RBD_BodySetLinearDamping(body, lin_damp#)
   body(body).lin_damp=lin_damp#
endfunction

function RBD_BodyGetLinearDamping(body)
d#=body(body).lin_damp
endfunction d#

function RBD_BodySetAngularDamping(body, ang_damp#)
   body(body).ang_damp=ang_damp#
endfunction

function RBD_BodyGetAngularDamping(body)
d#=body(body).ang_damp
endfunction d#


function RBD_BodyAddTorque(body)
   body(body).force.w=body(body).force.w+x vector2(RBD_V1)
endfunction

function RBD_BodySetTorque(body)
   body(body).force.w=x vector2(RBD_V1)
endfunction

function RBD_BodyAddForceGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)
   body(b).force.w=body(b).force.w+torque#
   R#=sqrt(RX#^2+RY#^2)
   body(b).force.x=body(b).force.x+FX#*abs(RX#/R#)
   body(b).force.y=body(b).force.y+FY#*abs(RY#/R#)
endfunction

function RBD_BodyAddForceLocal(b)
   set vector2 RBD_V3,cos(body(b).p.w),sin(body(b).p.w)
   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
   set vector2 RBD_V1,x vector2(RBD_V1)*x vector2(RBD_V3)+y vector2(RBD_V1)*x vector2(RBD_V4)+body(b).p.x,x vector2(RBD_V1)*y vector2(RBD_V3)+y vector2(RBD_V1)*y vector2(RBD_V4)+body(b).p.y
   set vector2 RBD_V2,x vector2(RBD_V2)*x vector2(RBD_V3)+y vector2(RBD_V2)*x vector2(RBD_V4),x vector2(RBD_V2)*y vector2(RBD_V3)+y vector2(RBD_V2)*y vector2(RBD_V4)
   RBD_BodyAddForceGlobal(b)
endfunction

function RBD_BodySetForceGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)/body(b).moi
   body(b).force.w=torque#
   R#=sqrt(RX#^2+RY#^2)
   body(b).force.x=FX#*abs(RX#/R#)
   body(b).force.y=FY#*abs(RY#/R#)
endfunction


function RBD_BodySetForceLocal(b)
   set vector2 RBD_V3,cos(body(b).p.w),sin(body(b).p.w)
   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
   set vector2 RBD_V1,x vector2(RBD_V1)*x vector2(RBD_V3)+y vector2(RBD_V1)*x vector2(RBD_V4)+body(b).p.x,x vector2(RBD_V1)*y vector2(RBD_V3)+y vector2(RBD_V1)*y vector2(RBD_V4)+body(b).p.y
   set vector2 RBD_V2,x vector2(RBD_V2)*x vector2(RBD_V3)+y vector2(RBD_V2)*x vector2(RBD_V4),x vector2(RBD_V2)*y vector2(RBD_V3)+y vector2(RBD_V2)*y vector2(RBD_V4)
   RBD_BodySetForceGlobal(b)
endfunction

function RBD_BodyAddImpulseGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)/body(b).moi
   body(b).impulse.w=body(b).impulse.w+torque#
   R#=sqrt(RX#^2+RY#^2)
   body(b).impulse.x=body(b).impulse.x+FX#*abs(RX#/R#)
   body(b).impulse.y=body(b).impulse.y+FY#*abs(RY#/R#)
endfunction

function RBD_BodyAddImpulseLocal(b)
   set vector2 RBD_V3,cos(body(b).p.w),sin(body(b).p.w)
   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
   set vector2 RBD_V1,x vector2(RBD_V1)*x vector2(RBD_V3)+y vector2(RBD_V1)*x vector2(RBD_V4)+body(b).p.x,x vector2(RBD_V1)*y vector2(RBD_V3)+y vector2(RBD_V1)*y vector2(RBD_V4)+body(b).p.y
   set vector2 RBD_V2,x vector2(RBD_V2)*x vector2(RBD_V3)+y vector2(RBD_V2)*x vector2(RBD_V4),x vector2(RBD_V2)*y vector2(RBD_V3)+y vector2(RBD_V2)*y vector2(RBD_V4)
   RBD_BodyAddImpulseGlobal(b)
endfunction

sync on
sync rate 0
cls
autocam off
position camera 0,0,-100
rotate camera 0,0,0
set ambient light 100
color backdrop 0

global max_body_amount=50
global max_vertex_amount=20
global max_collision_data_amount=20
global max_material_amount=20


type xy
   x as float
   y as float
endtype
type xyw
   x as float
   y as float
   w as float
endtype
type body_type
   p as xyw
   v as xyw
   force as xyw
   impulse as xyw
   mass as float
   moi as float
   vertex_amount
   exist as boolean
   gravity as boolean
   active as boolean
   autofreeze as boolean
   object
   lin_damp as float
   ang_damp as float
   collision_radius as float
   material
endtype
type collision_data_type
   vertex_amount
   exist as boolean
endtype
type world_type
   min as xy
   max as xy
   onexit
endtype
type collision_type
   pt as xy
   n as xy
   distance as float
endtype
type rbd_type
   world as world_type
   last_time
   collision as collision_type
endtype
type material_type
   sfriction as float
   kfriction as float
   elasticity as float
   collidable as boolean
endtype

dim body(max_body_amount) as body_type
dim body_shape(max_body_amount,max_vertex_amount) as xy
dim collision_data(max_collision_data_amount+2) as collision_data_type
dim collision_data_v(max_collision_data_amount,max_vertex_amount) as xy
dim material(max_material_amount,max_material_amount) as material_type
dim groupid(max_material_amount)
global RBD as rbd_type
global RBD_V1=1
global RBD_V2=2
global RBD_V3=3
global RBD_V4=4
n=make vector2(RBD_V1)
n=make vector2(RBD_V2)
n=make vector2(RBD_V3)
n=make vector2(RBD_V4)
RBD_Create()
col=RBD_CreateBox(10.0,10.0)
n=0
for y=1 to 5
for x=1 to y
inc n
make object plain n,10.0,10.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).p.y=25.0*y
body(b).p.x=15.0*(x-(y+1)*0.5)
body(b).p.w=0.001
next x
next y
n=n+1
col=RBD_CreateBox(80.0,5.0)
make object plain n,80.0,5.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).mass=0
inc n
make object plain n,80.0,5.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).p.w=90
body(b).p.x=40
body(b).p.y=40
body(b).mass=0
inc n
make object plain n,80.0,5.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).p.w=90
body(b).p.x=-40
body(b).p.y=40
body(b).mass=0



global time# as float
do
   time#=RBD_GetElapsedTimeInSec()
   RBD_Update(time#)
   set cursor 0,0
   print screen fps()
   set vector2 RBD_V1,0,1
   set vector2 RBD_V2,0,30*(upkey()-downkey())
   RBD_BodyAddForceLocal(body1)
   set vector2 RBD_V1,-(rightkey()-leftkey())*90.0,0
   RBD_BodyAddTorque(body1)
   sync
loop

function RBD_Create()
   RBD.world.min.x=-100.0
   RBD.world.max.x=100.0
   RBD.world.min.y=-100.0
   RBD.world.max.y=100.0
   RBD.last_time=timer()
   RBD.world.onexit=0
   local b
   for b=0 to max_body_amount
      body(b).exist=0
   next b
   material(0,0).collidable=1
   material(0,0).elasticity=0.1
   material(0,0).sfriction=0.1
   material(0,0).kfriction=0.1
   groupid(0)=1
endfunction

function RBD_Update(time#)
   for b=0 to max_body_amount
      if body(b).exist=1
         if RBD.world.onexit=1
            if body(b).p.x<RBD.world.min.x or body(b).p.y<RBD.world.min.y or body(b).p.x>RBD.world.max.x or body(b).p.y>RBD.world.max.y then body(b).exist=0
         endif

         body(b).force.x=body(b).force.x-body(b).lin_damp*body(b).v.x*abs(body(b).v.x)*time#
         body(b).force.y=body(b).force.y-body(b).lin_damp*body(b).v.y*abs(body(b).v.y)*time#
         body(b).force.w=body(b).force.w-body(b).ang_damp*body(b).v.w*abs(body(b).v.w)*time#
         if body(b).mass>0
            body(b).v.x=body(b).v.x+body(b).force.x/body(b).mass*time#+body(b).impulse.x/body(b).mass
            body(b).v.y=body(b).v.y+body(b).force.y/body(b).mass*time#+body(b).impulse.y/body(b).mass
            body(b).v.w=body(b).v.w+body(b).force.w/body(b).moi*time#+body(b).impulse.w/body(b).moi
         else
            body(b).v.x=0
            body(b).v.y=0
            body(b).v.w=0
         endif
         body(b).force.x=0
         body(b).force.y=-9.8
         body(b).force.w=0
         body(b).impulse.x=0
         body(b).impulse.y=0
         body(b).impulse.w=0
         body(b).p.x=body(b).p.x+body(b).v.x*time#
         body(b).p.y=body(b).p.y+body(b).v.y*time#
         body(b).p.w=body(b).p.w+body(b).v.w*time#
         if body(b).object>0
            position object body(b).object,body(b).p.x,body(b).p.y,0
            rotate object body(b).object,0,0,body(b).p.w
         endif
         for b2=0 to max_body_amount
            if body(b2).exist=1
               if b<>b2 and material(body(b).material,body(b2).material).collidable=1
                  d2#=(body(b).p.x-body(b2).p.x)^2+(body(b).p.y-body(b2).p.y)^2
                  if d2#<(body(b).collision_radius+body(b2).collision_radius)^2
                     col=BodyCollision(b,b2)
                     if col=1
                        `print "Collision at (",RBD.collision.pt.x,",",RBD.collision.pt.y,")"
                        `print "Collision normal is (",RBD.collision.n.x,",",RBD.collision.n.y,")"
                        `print "Collision distance = ",RBD.collision.distance
                        rx#=RBD.collision.pt.x-body(b).p.x
                        ry#=RBD.collision.pt.y-body(b).p.y
                        r#=sqrt(rx#^2+ry#^2)
                        tx#=-ry#/r#
                        ty#=rx#/r#
                        tv#=(body(b).v.w*r#)*3.14159/180.0
                        mx_b1_at_pt#=body(b).v.x*body(b).mass +tv#*(tx#)*body(b).moi
                        my_b1_at_pt#=body(b).v.y*body(b).mass +tv#*(ty#)*body(b).moi
                        m1#=mx_b1_at_pt#*-RBD.collision.n.x+my_b1_at_pt#*-RBD.collision.n.y
                        rx#=RBD.collision.pt.x-body(b2).p.x
                        ry#=RBD.collision.pt.y-body(b2).p.y
                        r#=sqrt(rx#^2+ry#^2)
                        tx#=-ry#/r#
                        ty#=rx#/r#
                        tv#=(body(b2).v.w*r#)*3.14159/180.0
                        mx_b2_at_pt#=body(b2).v.x*body(b2).mass +tv#*(tx#)*body(b2).moi
                        my_b2_at_pt#=body(b2).v.y*body(b2).mass +tv#*(ty#)*body(b2).moi
                        m2#=mx_b2_at_pt#*RBD.collision.n.x+my_b2_at_pt#*RBD.collision.n.y
                        total_momentum#=(m1#+m2#)*(material(body(b).material,body(b2).material).elasticity+1)
                        if total_momentum#>0
                           set vector2 RBD_V1,RBD.collision.pt.x,RBD.collision.pt.y
                           if body(b).mass>0
                              if body(b2).mass=0
                                 set vector2 RBD_V2,total_momentum#*(RBD.collision.n.x),total_momentum#*(RBD.collision.n.y)
                                 RBD_BodyADDImpulseGlobal(b)
                              else
                                 set vector2 RBD_V2,total_momentum#*(RBD.collision.n.x)*body(b).mass/(body(b).mass+body(b2).mass),total_momentum#*(RBD.collision.n.y)*body(b).mass/(body(b).mass+body(b2).mass)
                                 RBD_BodyADDImpulseGlobal(b)
   `                              set vector2 RBD_V2,total_momentum#*(RBD.collision.n.x)*body(b2).mass/(body(b).mass+body(b2).mass),total_momentum#*(RBD.collision.n.y)*body(b2).mass/(body(b).mass+body(b2).mass)
   `                              RBD_BodyADDImpulseGlobal(b2)
                              endif
   `                        else
   `                           if body(b2).mass>0
   `                              set vector2 RBD_V2,total_momentum#*(-RBD.collision.n.x),total_momentum#*(-RBD.collision.n.y)
   `                              RBD_BodyADDImpulseGlobal(b)
   `                           endif
                           endif
                        endif


                     endif
                  endif
               endif
            endif
         next b2
      endif
   next b
   local c
   for c=0 to max_collision_data_amount
      collision_data(c).exist=0
   next c
endfunction

function RBD_GetElapsedTimeInSec()
   t#=(timer()-RBD.last_time)*0.001
   RBD.last_time=timer()
   if t#<0.001 then t#=0.001
endfunction t#

function RBD_SetWorldSize()
   RBD.world.min.x=x vector2(RBD_V1)
   RBD.world.min.y=y vector2(RBD_V1)
   RBD.world.max.x=x vector2(RBD_V2)
   RBD.world.max.y=y vector2(RBD_V2)
endfunction

function RBD_CreateBox(sx#,sy#)
   local c=0
   while collision_data(c).exist=1
      inc c
   endwhile
   collision_data(c).exist=1
   collision_data(c).vertex_amount=4
   collision_data_v(c,0).x=sx#*0.5
   collision_data_v(c,0).y=sy#*0.5

   collision_data_v(c,1).x=sx#*0.5
   collision_data_v(c,1).y=-sy#*0.5

   collision_data_v(c,2).x=-sx#*0.5
   collision_data_v(c,2).y=-sy#*0.5

   collision_data_v(c,3).x=-sx#*0.5
   collision_data_v(c,3).y=sy#*0.5
endfunction c

function RBD_CreateBody(col)
   local b=0
   while body(b).exist=1
      inc b
   endwhile
   body(b).exist=1
   body(b).p.x=0
   body(b).p.y=0
   body(b).p.w=0
   body(b).v.x=0
   body(b).v.y=0
   body(b).v.w=0
   body(b).force.x=0
   body(b).force.y=0
   body(b).force.w=0
   body(b).impulse.x=0
   body(b).impulse.y=0
   body(b).impulse.w=0
   body(b).mass=1
   body(b).moi=1
   body(b).gravity=1
   body(b).active=1
   body(b).autofreeze=1
   body(b).lin_damp=0.1
   body(b).ang_damp=0.1
   body(b).vertex_amount=collision_data(col).vertex_amount
   body(b).material=0
   local v
   rad2#=0
   for v=0 to body(b).vertex_amount-1
      body_shape(b,v).x=collision_data_v(col,v).x
      body_shape(b,v).y=collision_data_v(col,v).y
      r#=collision_data_v(col,v).x^2+collision_data_v(col,v).y^2
      if r#>rad2#
         rad2#=r#
      endif
   next v
   body(b).collision_radius=sqrt(rad2#)
endfunction b

function RBD_DestroyBody(b)
   body(b).exist=0
endfunction

function RBD_BodyGetRotation(b)
   set vector2 RBD_V1,body(b).p.w,0
endfunction

function RBD_BodyGetPosition(b)
   set vector2 RBD_V1,body(b).p.x,body(b).p.y
endfunction

function RBD_DestroyAllBodies()
   local b
   for b=0 to max_body_amount
      RBD_DestroyBody(b)
   next b
endfunction

function RBD_SetBodyLeaveWorldEvent(flag)
   RBD.world.onexit=flag
endfunction

function RBD_BodySetDBProData(body, db_num)
   body(body).object=db_num
endfunction

function RBD_BodySetVelocity(body)
   body(body).v.x=x vector2(RBD_V1)
   body(body).v.y=y vector2(RBD_V1)
endfunction

function RBD_BodyGetVelocity(body)
   set vector2 RBD_V1,body(body).v.x,body(body).v.y
endfunction

function RBD_BodySetOmega(body)
   body(body).v.w=x vector2(RBD_V1)
endfunction

function RBD_BodyGetOmega(body)
   set vector2 RBD_V1,body(body).v.w,0
endfunction

function RBD_BodySetLinearDamping(body, lin_damp#)
   body(body).lin_damp=lin_damp#
endfunction

function RBD_BodyGetLinearDamping(body)
d#=body(body).lin_damp
endfunction d#

function RBD_BodySetAngularDamping(body, ang_damp#)
   body(body).ang_damp=ang_damp#
endfunction

function RBD_BodyGetAngularDamping(body)
d#=body(body).ang_damp
endfunction d#


function RBD_BodyAddTorque(body)
   body(body).force.w=body(body).force.w+x vector2(RBD_V1)
endfunction

function RBD_BodySetTorque(body)
   body(body).force.w=x vector2(RBD_V1)
endfunction

function RBD_BodyAddForceGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)
   body(b).force.w=body(b).force.w+torque#
   R#=sqrt(RX#^2+RY#^2)
   body(b).force.x=body(b).force.x+FX#*abs(RX#/R#)
   body(b).force.y=body(b).force.y+FY#*abs(RY#/R#)
endfunction

function RBD_BodyAddForceLocal(b)
`   set vector2 RBD_V3,cos(body(b).p.w),sin(body(b).p.w)
`   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
`   set vector2 RBD_V1,x vector2(RBD_V1)*x vector2(RBD_V3)+y vector2(RBD_V1)*x vector2(RBD_V4)+body(b).p.x,x vector2(RBD_V1)*y vector2(RBD_V3)+y vector2(RBD_V1)*y vector2(RBD_V4)+body(b).p.y
`   set vector2 RBD_V2,x vector2(RBD_V2)*x vector2(RBD_V3)+y vector2(RBD_V2)*x vector2(RBD_V4),x vector2(RBD_V2)*y vector2(RBD_V3)+y vector2(RBD_V2)*y vector2(RBD_V4)
   rotate_vector2(RBD_V1,body(b).p.w)
   set vector2 RBD_V1,x vector2(RBD_V1)+body(b).p.x,y vector2(RBD_V1)+body(b).p.y
   rotate_vector2(RBD_V2,body(b).p.w)
   RBD_BodyAddForceGlobal(b)
endfunction

function RBD_BodySetForceGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)/body(b).moi
   body(b).force.w=torque#
   R#=sqrt(RX#^2+RY#^2)
   body(b).force.x=FX#*abs(RX#/R#)
   body(b).force.y=FY#*abs(RY#/R#)
endfunction


function RBD_BodySetForceLocal(b)
`   set vector2 RBD_V3,cos(body(b).p.w),sin(body(b).p.w)
`   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
`   set vector2 RBD_V1,x vector2(RBD_V1)*x vector2(RBD_V3)+y vector2(RBD_V1)*x vector2(RBD_V4)+body(b).p.x,x vector2(RBD_V1)*y vector2(RBD_V3)+y vector2(RBD_V1)*y vector2(RBD_V4)+body(b).p.y
`   set vector2 RBD_V2,x vector2(RBD_V2)*x vector2(RBD_V3)+y vector2(RBD_V2)*x vector2(RBD_V4),x vector2(RBD_V2)*y vector2(RBD_V3)+y vector2(RBD_V2)*y vector2(RBD_V4)
   rotate_vector2(RBD_V1,body(b).p.w)
   set vector2 RBD_V1,x vector2(RBD_V1)+body(b).p.x,y vector2(RBD_V1)+body(b).p.y
   rotate_vector2(RBD_V2,body(b).p.w)
   RBD_BodySetForceGlobal(b)
endfunction

function RBD_BodyAddImpulseGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)
   body(b).impulse.w=body(b).impulse.w+torque#
   R#=sqrt(RX#^2+RY#^2)
   body(b).impulse.x=body(b).impulse.x+FX#*abs(RX#/R#)
   body(b).impulse.y=body(b).impulse.y+FY#*abs(RY#/R#)
endfunction

function RBD_BodyAddImpulseLocal(b)
`   set vector2 RBD_V3,cos(body(b).p.w),sin(body(b).p.w)
`   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
   rotate_vector2(RBD_V1,body(b).p.w)
   set vector2 RBD_V1,x vector2(RBD_V1)+body(b).p.x,y vector2(RBD_V1)+body(b).p.y
   rotate_vector2(RBD_V2,body(b).p.w)
`   set vector2 RBD_V1,x vector2(RBD_V1)*x vector2(RBD_V3)+y vector2(RBD_V1)*x vector2(RBD_V4)+body(b).p.x,x vector2(RBD_V1)*y vector2(RBD_V3)+y vector2(RBD_V1)*y vector2(RBD_V4)+body(b).p.y
`   set vector2 RBD_V2,x vector2(RBD_V2)*x vector2(RBD_V3)+y vector2(RBD_V2)*x vector2(RBD_V4),x vector2(RBD_V2)*y vector2(RBD_V3)+y vector2(RBD_V2)*y vector2(RBD_V4)
   RBD_BodyAddImpulseGlobal(b)
endfunction

function rotate_vector2(v,r#)
   set vector2 RBD_V3,cos(r#),sin(r#)
   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
   set vector2 v,x vector2(v)*x vector2(RBD_V3)+y vector2(v)*x vector2(RBD_V4),x vector2(v)*y vector2(RBD_V3)+y vector2(v)*y vector2(RBD_V4)
endfunction

function BodyCollision(b1,b2)
   if body(b2).vertex_amount<body(b1).vertex_amount
      bt=b1
      b1=b2
      b2=bt
   endif
   va1=body(b1).vertex_amount
   va2=body(b2).vertex_amount
   RBD.collision.distance=100000
   for v=0 to va1-1
      `print v,",",mod((v+1),(va1)),": ";
     ` print body_shape(b1,v).x,",",body_shape(b1,v).y
      vx#=body_shape(b1,mod((v+1),(va1))).x-body_shape(b1,v).x
      vy#=body_shape(b1,mod((v+1),(va1))).y-body_shape(b1,v).y
      set vector2 RBD_V1,vx#,vy#
      `print vx#,",",vy#,": ";
      normalize vector2 RBD_V1,RBD_V1
      rotate_vector2(RBD_V1,body(b1).p.w+90)
      minv1#=100000
      minv1=0
      maxv1#=-100000
      maxv1=0
      minv2#=100000
      minv2=0
      maxv2#=-100000
      maxv2=0
     ` print x vector2(RBD_V1),",",y vector2(RBD_V1)
      for v1=0 to va1-1
         set vector2 RBD_V2,body_shape(b1,v1).x,body_shape(b1,v1).y
         rotate_vector2(RBD_V2,body(b1).p.w)

         set vector2 RBD_V2,x vector2(RBD_V2)+body(b1).p.x,y vector2(RBD_V2)+body(b1).p.y
         v1#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
         if v1#<minv1#
            minv1#=v1#
            minv1=v1
         endif
         if v1#>maxv1#
            maxv1#=v1#
            maxv1=v1
         endif
      next v1
      for v2=0 to va2-1
         set vector2 RBD_V2,body_shape(b2,v2).x,body_shape(b2,v2).y
         rotate_vector2(RBD_V2,body(b2).p.w)
         set vector2 RBD_V2,x vector2(RBD_V2)+body(b2).p.x,y vector2(RBD_V2)+body(b2).p.y
         v2#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
         if v2#<minv2#
            minv2#=v2#
            minv2=v2
         endif
         if v2#>maxv2#
            maxv2#=v2#
            maxv2=v2
         endif
      next v2
`      print "min v1:",minv1#;
`      print " max v1:",maxv1#;
`      print " min v2:",minv2#;
`      print " max v2:",maxv2#
      if maxv1#-0.0001<=minv2# or maxv2#-0.0001<=minv1#
         exitfunction 0
      else
         if maxv2#>maxv1#
            d#=maxv1#-minv2#
            cv=minv2
`            if maxv2#-maxv1#<d#
`               d#=maxv2#-minv1#
`               cv=maxv2
`            endif
            if d#>0
            `print "c";
               `print " d=",d#
               if d#<RBD.collision.distance
                  RBD.collision.distance=d#
                  set vector2 RBD_V2,body_shape(b2,cv).x,body_shape(b2,cv).y
                  rotate_vector2(RBD_V2,body(b2).p.w)
                  set vector2 RBD_V2,x vector2(RBD_V2)+body(b2).p.x,y vector2(RBD_V2)+body(b2).p.y
                  RBD.collision.pt.x=x vector2(RBD_V2)
                  RBD.collision.pt.y=y vector2(RBD_V2)
                  RBD.collision.n.x=-x vector2(RBD_V1)
                  RBD.collision.n.y=-y vector2(RBD_V1)
               endif
            endif
         endif
      endif
   next v
   for v=0 to va2-1
     ` print v,",",mod((v+1),(va2)),": ";
    `  print body_shape(b2,v).x,",",body_shape(b2,v).y

      vx#=body_shape(b2,mod((v+1),(va2))).x-body_shape(b2,v).x
      vy#=body_shape(b2,mod((v+1),(va2))).y-body_shape(b2,v).y

     ` print vx#,",",vy#,": ";
      set vector2 RBD_V1,vx#,vy#
      normalize vector2 RBD_V1,RBD_V1
      rotate_vector2(RBD_V1,body(b2).p.w+90)
      minv1#=100000
      minv1=0
      maxv1#=-100000
      maxv1=0
      minv2#=100000
      minv2=0
      maxv2#=-100000
      maxv2=0

      `print x vector2(RBD_V1),",",y vector2(RBD_V1)
      for v1=0 to va1-1
         set vector2 RBD_V2,body_shape(b1,v1).x,body_shape(b1,v1).y
         rotate_vector2(RBD_V2,body(b1).p.w)
         set vector2 RBD_V2,x vector2(RBD_V2)+body(b1).p.x,y vector2(RBD_V2)+body(b1).p.y
         v1#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
         if v1#<minv1#
            minv1#=v1#
            minv1=v1
         endif
         if v1#>maxv1#
            maxv1#=v1#
            maxv1=v1
         endif
      next v1
      for v2=0 to va2-1
         set vector2 RBD_V2,body_shape(b2,v2).x,body_shape(b2,v2).y
         rotate_vector2(RBD_V2,body(b2).p.w)
         set vector2 RBD_V2,x vector2(RBD_V2)+body(b2).p.x,y vector2(RBD_V2)+body(b2).p.y
         v2#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
         if v2#<minv2#
            minv2#=v2#
            minv2=v2
         endif
         if v2#>maxv2#
            maxv2#=v2#
            maxv2=v2
         endif
      next v2

`      print "min v1:",minv1#;
`      print " max v1:",maxv1#;
`      print " min v2:",minv2#;
`      print " max v2:",maxv2#
      if  maxv1#-0.0001<=minv2# or maxv2#-0.0001<=minv1#
         exitfunction 0
      else
         if maxv1#>maxv2#
            d#=maxv2#-minv1#
            cv=minv1
`            if maxv1#-minv2#<d#
`               d#=maxv1#-minv2#
`               cv=maxv1
`            endif
            if d#>0
              ` print "c";
               `print " d=",d#
               if d#<RBD.collision.distance
                  RBD.collision.distance=d#
                  set vector2 RBD_V2,body_shape(b1,cv).x,body_shape(b1,cv).y
                  rotate_vector2(RBD_V2,body(b1).p.w)
                  set vector2 RBD_V2,x vector2(RBD_V2)+body(b1).p.x,y vector2(RBD_V2)+body(b1).p.y
                  RBD.collision.pt.x=x vector2(RBD_V2)
                  RBD.collision.pt.y=y vector2(RBD_V2)
                  RBD.collision.n.x=x vector2(RBD_V1)
                  RBD.collision.n.y=y vector2(RBD_V1)
               endif
            endif
         endif
      endif
   next v
endfunction 1

function mod(a,b)
while a>=b
   dec a,b
endwhile
endfunction a

function RBD_GetBody(obj)
   for b=0 to max_body_amount
      if body(b).exist=1
         if body(b).object=obj
            exitfunction b
         endif
      endif
   next b
endfunction -1

function RBD_GetDBPro(body)
   obj=body(body).object
endfunction obj

function RBD_MaterialGetDefaultGroupID()
endfunction 0

function RBD_MaterialCreateGroupID()
   i=0
   while groupid(i)=1
      inc i
   endwhile
   groupid(i)=1
   for n=0 to max_material_amount
      material(i,n).collidable=1
      material(i,n).elasticity=1.0
   next n
endfunction i

function RBD_MaterialSetDefaultCollidable(mat1,mat2,state)
   material(mat1,mat2).collidable=state
endfunction

function RBD_MaterialSetDefaultFriction(mat1,mat2,sfriction#,kfriction#)
   material(mat1,mat2).sfriction=sfriction#
   material(mat1,mat2).kfriction=kfriction#
endfunction

function RBD_MaterialSetDefaultElasticity(mat1,mat2,elasticity#)
   material(mat1,mat2).elasticity=elasticity#
endfunction

function mod(a,b)
RV = int(a / b)
RV = RV * b
RV = a - RV
endfunction RV

sync on
sync rate 30
set display mode 1024,768,32

Type MagnetInfo
   Xpos
   Ypos
   Str#
endtype
type BallInfo
   Xspeed#
   Yspeed#
   Zspeed#
   Xpos#
   Ypos#
   Used
endtype
type BasicBallInfo
   AirFric#
   GndFric#
   Grav#
endtype
type MouseInfo
   Left
   Right

   StartX
   StartY
endtype

global Mouse as MouseInfo
dim Balls(0) as BallInfo

Setup_Ground()
Setup_Mags(20)
Setup_Ball()

do
   `draw the ground
   for Xpos = 0 to screen width() step 100
   for Ypos = 0 to screen height() step 100
   paste image GroundImage,Xpos,Ypos
   next Ypos
   next Xpos

   `draw the sky
   ink RGB(0,255,255),0
   for Xpos = 0 to screen width()
      line Xpos,0,Xpos,screen height()-GroundHeight(Xpos)
   next Xpos

   `draw the magnets
   for MagSlot = 0 to array count(Magnets(0))
      paste image MagImage,Magnets(MagSlot).Xpos-25,Magnets(MagSlot).Ypos-25,1
   next MagSlot

   `move the ball around
   Handle_Balls()

   `handle user clicking
   if mouseclick() = 1 and Mouse.Left = 0
      Mouse.Left = 1

      `rember this as the start of the click
      Mouse.StartX = MouseX()
      Mouse.StartY = MouseY()
   endif
   `handle mouse holding
   if mouseClick() = 1 and Mouse.Left = 1
      ink rgb(255,255,0),0
      line Mouse.StartX,Mouse.StartY,MouseX(),MouseY()
   endif
   `handle the end of a click
   if mouseClick() = 0 and Mouse.Left = 1
      Mouse.Left = 0
      `create a new ball
      BallSlot = Create_Ball()

      `set the ball to the users start post and give it new speeds
      Balls(BallSlot).Xpos# = Mouse.StartX
      Balls(BallSlot).Ypos# = Mouse.StartY

      Ang# = atanfull(Mouse.StartX-MouseX(),Mouse.StartY-MouseY())
      Dist# = sqrt((Mouse.StartX-MouseX())^2+(Mouse.StartY-MouseY())^2)
      Balls(BallSlot).Xspeed# = newXvalue(0,Ang#,Dist#/4.0)
      Balls(BallSlot).Yspeed# = newZvalue(0,Ang#,Dist#/4.0)
   endif
sync
loop

function Handle_Balls()
`go through all balls
for BallSlot = 0 to array count(Balls(0))
if Balls(BallSlot).Used = 1
   `---------------
   `handle the ball
   `---------------
   `move the ball based on speeds
   Balls(BallSlot).Xpos# = Balls(BallSlot).Xpos# + Balls(BallSlot).Xspeed#
   Balls(BallSlot).Ypos# = Balls(BallSlot).Ypos# + Balls(BallSlot).Yspeed#

   `apply gravity
   inc Balls(BallSlot).Yspeed#,Ball.Grav#

   `apply air friction
   Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#*Ball.AirFric#
   Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#*Ball.AirFric#

   `check for collision with all other balls
   dim TempX#(array count(Balls(0)))
   dim TempY#(array count(Balls(0)))
   for CheckSlot = 0 to array count(Balls(0))
   if Balls(CheckSlot).Used = 1 and CheckSlot <> BallSlot
   remstart
      if abs(Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#) <= 6 and abs(Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#) <= 6
         TempX#(BallSlot) = Balls(BallSlot).Xpos#+(Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#)/6.0
         TempY#(BallSlot) = Balls(BallSlot).Ypos#+(Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#)/6.0

         TempX#(CheckSlot) = Balls(CheckSlot).Xpos#+(Balls(CheckSlot).Xpos#-Balls(BallSlot).Xpos#)/6.0
         TempY#(CheckSlot) = Balls(CheckSlot).Ypos#+(Balls(CheckSlot).Ypos#-Balls(BallSlot).Ypos#)/6.0
      endif

      Dist# = sqrt((Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#)^2+(Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#)^2)
      Ang# = atanfull(Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#,Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#)+180

      `if it is colliding with the other ball then position in around the edge
      if Dist# <= 6
         Balls(BallSlot).Xpos# = newXvalue(Balls(BallSlot).Xpos#,Ang#,Dist#-5)
         Balls(BallSlot).Ypos# = newZvalue(Balls(BallSlot).Ypos#,Ang#,Dist#-5)

         `flip the speeds
         TempXSpeed# = Balls(BallSlot).Xspeed#
         TempYSpeed# = Balls(BallSlot).Yspeed#

         Balls(BallSlot).Xspeed# = Balls(CheckSlot).Xspeed#
         Balls(BallSlot).Yspeed# = Balls(CheckSlot).Yspeed#

         Balls(CheckSlot).Xspeed# = TempXSpeed#
         Balls(CheckSlot).Yspeed# = TempYSpeed#

      endif
remend
   endif
   next CheckSlot

   `apply magnets
   for MagSlot = 0 to array count(Magnets(0))
      `get the distance to this magnet
      Dist# = sqrt((Balls(BallSlot).Xpos#-Magnets(MagSlot).Xpos)^2+(Balls(BallSlot).Ypos#-Magnets(MagSlot).Ypos)^2)
      `calculate force
      Force# = (8.5*Magnets(MagSlot).Str#*10)/Dist#^2

      `turn the force into x/y speeds
      Ang# = atanfull(Balls(BallSlot).Xpos#-Magnets(MagSlot).Xpos,Balls(BallSlot).Ypos#-Magnets(MagSlot).Ypos)+180
      Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#+newXvalue(0,Ang#,Force#)
      Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#+newZvalue(0,Ang#,Force#)

      `if it is colliding with the magnet then position in around the edge
      if Dist# <= 12
         Balls(BallSlot).Xpos# = newXvalue(Balls(BallSlot).Xpos#,Ang#,Dist#-11)
         Balls(BallSlot).Ypos# = newZvalue(Balls(BallSlot).Ypos#,Ang#,Dist#-11)

         `apply magnet friction
         Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#*0
         Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#*0
      endif
   next MagSlot

   `don't let the ball go below ground
   if Balls(BallSlot).Ypos# > screen height()-Get_GroundHeight(Balls(BallSlot).Xpos#)-2
      `position in at ground level
      Balls(BallSlot).Ypos# = screen height()-Get_GroundHeight(Balls(BallSlot).Xpos#)-2

      `-----------------
      `calculate rolling
      `-----------------
      `get ground height difference
      Height# = Get_GroundHeight(Balls(BallSlot).Xpos#+2)
      Height# = Get_GroundHeight(Balls(BallSlot).Xpos#-2)-Height#
      Ang# = atanfull(4,Height#)
      Ang# = (Ang#-180)
      Pcnt# = Ang#/180.0
      Pcnt# = (1-(Pcnt#/0.5))-2

      `ajust the X and Y speeds based on height and gravity
      Balls(BallSlot).Yspeed# = Pcnt#*Ball.Grav#
      Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed# + Pcnt#*Ball.Grav#

      `apply ground friction
      Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#*Ball.GndFric#
      Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#*Ball.GndFric#
   endif

   paste image BallImage,Balls(BallSlot).Xpos#-5,Balls(BallSlot).Ypos#-5,1
endif
next BallSlot
endfunction

function Setup_Ground()
   `make a ground image
   global GroundImage
   GroundImage = Get_FreeImg()
   Create_GroundImage(GroundImage)

   `dim the array
   Dim GroundHeight(screen width())

   `make rnd sin rates
   global Rate1
   global Rate2
   global Rate3
   Rate1 = rnd(4)+1
   Rate2 = rnd(4)+1
   Rate3 = rnd(4)+1

   `set all the heights
   for Xpos = 0 to screen width()
      GroundHeight(Xpos) = sin(Xpos*Rate1)*4+sin(Xpos*Rate2)*4+sin(Xpos*Rate3)*4+(Xpos/5.0)
   next Xpos
endfunction

function Setup_Mags(MagAmount)
   `dim the Mag array
   dim Magnets(MagAmount) as MagnetInfo

   `setup the image
   global MagImage
   MagImage = Get_FreeImg()
   Create_MagImage(MagImage,0,0,255)

   `randomly position the magnets
   for MagSlot = 0 to MagAmount
      Magnets(MagSlot).Xpos = rnd(screen width())
      Magnets(MagSlot).Ypos = rnd(screen height()-GroundHeight(Magnets(MagSlot).Xpos)-50)
      Magnets(MagSlot).Str# = rnd(5)+5
   next MagSlot
endfunction

function Setup_Ball()
   `make the image
   global BallImage
   BallImage = Get_FreeImg()
   Create_BallImage(BallImage)

   `setup the ball
   global Ball as BasicBallInfo

   Ball.AirFric# = 0.99
   Ball.GndFric# = 0.95
   Ball.Grav# = 0.5
endfunction

function Create_Ball()
   `find/make a ball
   for BallSlot = 0 to array count(Balls(0))
      if Balls(BallSlot).Used = 0 then exit
   next BallSlot
   if BallSlot > array count(Balls(0)) then array insert at bottom Balls(0)

   `setup the ball
   Balls(BallSlot).Used = 1
endfunction BallSlot

function Create_GroundImage(ImgNum)
   TempBmp = Get_FreeBmp()
   create bitmap TempBmp,100,100
   cls RGB(128,64,0)

   `draw the dirt
   for X = 0 to 100 step 10
   for y = 0 to 100 step 10
      `make the box a random shade of brown
      Pcnt# = rnd(100)/100.0
      ink RGB(150*Pcnt#,100*Pcnt#,0),0
      box X,Y,X+10,Y+10
   next y
   next x

   `go through twice and make shades of green for grass
   for Num = 1 to 2
   for X = -10 to 100
   for y = -10 to 100
      `get a shade
      ink RGB(0,rnd(100)+50,0),0
      inc sin#
      box X,Y,X+(sin(sin#)*2)*(rnd(7)+1),Y+(cos(sin#)*2)*(rnd(7)+1)
   next y
   next x
   blur bitmap TempBmp,2
   next Num

   `save the image
   get image ImgNum,0,0,100,100
   delete bitmap TempBmp
endfunction

function Create_MagImage(ImgNum,Red,Green,Blue)
make memblock 1,4*50*50+12
write memblock dword 1,0,50
write memblock dword 1,4,50
write memblock dword 1,8,32

for X = 0 to 50
for y = 0 to 50

Dist# = sqrt((X-25)^2+(Y-25)^2)
if Dist# < 10
   Pcnt# = 1-(Dist#/20.0)
   `Pcnt# = abs(sin(Pcnt#*45))

   MemPos = (Y*50+X)*4+12

   write memblock byte 1,MemPos,Red*Pcnt#
   write memblock byte 1,MemPos+1,Green*Pcnt#
   write memblock byte 1,MemPos+2,Blue*Pcnt#

   `get a differnt percent for alpha
   Pcnt# = 1-(Dist#/20.0)
   Pcnt# = abs(sin(Pcnt#*90))
   write memblock byte 1,MemPos+3,255
endif
next Y
next X

make image from memblock ImgNum,1
delete memblock 1
endfunction

function Create_BallImage(ImgNum)
make memblock 1,4*10*10+12
write memblock dword 1,0,10
write memblock dword 1,4,10
write memblock dword 1,8,32

for X = 0 to 10
for Y = 0 to 10
   MemPos = (Y*10+X)*4+12

   `make shure its within a certan dist from center
   Dist# = sqrt((X-5)^2+(Y-5)^2)
   if Dist# < 2.5
      Pcnt# = 1-(Dist#/5.0)
      `Pcnt# = abs(sin(Pcnt#*90))

      write memblock byte 1,MemPos,128*Pcnt#
      write memblock byte 1,MemPos+1,255*Pcnt#
      write memblock byte 1,MemPos+2,0*Pcnt#
      write memblock byte 1,MemPos+3,255
   endif

next Y
next X

make image from memblock ImgNum,1
delete memblock 1
endfunction

function Get_GroundHeight(Xpos#)
  Height# = sin(Xpos#*Rate1)*4+sin(Xpos#*Rate2)*4+sin(Xpos#*Rate3)*4+(Xpos#/5.0)
endfunction Height#

`get the first open ID
function Get_FreeBmp()
   repeat
      inc BmpID
   until Bitmap exist(BmpID) = 0
endfunction BmpID
function Get_FreeImg()
   repeat
      inc ImgID
   until Image exist(ImgID) = 0
endfunction ImgID
function Get_FreeObj()
   repeat
      inc ObjID
   until Object exist(ObjID) = 0
endfunction ObjID

`2D Physics
sync on : sync rate 60
set display mode 1024,768,32 : `hide mouse

`types
type vec
   x as float
   y as float
   m as float
endtype
type force
   f1 as vec
   f2 as vec
   fw as vec
   fd as vec
   f as vec
endtype
type tscene
   grav as float
   density as float
endtype
scene as tscene

type tball
   pos as vec
   acc as vec
   vel as vec
   mom as vec
   ang as float
   frc as force
   mass as float
   weight as float
   size as float
   drag as float
   collision as boolean
   bmdist as float
endtype

`setup scene
scene.grav=0.8
scene.density=0.01

`create balls
balls=3
dim ball(balls) as tball
for b=1 to balls
   ball(b).pos.x=rnd(screen width())
   ball(b).pos.y=rnd(screen height())
   ball(b).size=rnd(20)+20
   ball(b).mass=rnd(20)+20
   ball(b).weight=ball(b).mass*scene.grav
   ball(b).drag=0.47
next b



`main loop
do

`control balls
for b=1 to balls
   ball(b).bmdist=sqrt((mousex()-ball(b).pos.x)^2+(mousey()-ball(b).pos.y)^2)
   ball(b).frc.f1.x=sin(ball(b).ang)*(ball(b).bmdist/6)
   ball(b).frc.f1.y=cos(ball(b).ang)*(ball(b).bmdist/6)
   ball(b).ang=atanfull(mousex()-ball(b).pos.x,mousey()-ball(b).pos.y)
   ball(b).mom.x=ball(b).mass*ball(b).vel.x : ball(b).mom.y=ball(b).mass*ball(b).vel.y
   ball(b).frc.fd.x=-(ball(b).drag/2)*(ball(b).size*2)*scene.density*((ball(b).vel.x^2)*sign(ball(b).vel.x))
   ball(b).frc.fd.y=-(ball(b).drag/2)*(ball(b).size*2)*scene.density*((ball(b).vel.y^2)*sign(ball(b).vel.y))
   ball(b).frc.fw.y=ball(b).weight
   if ball(b).pos.x<=0 or ball(b).pos.y<=0 or ball(b).pos.x>screen width() or ball(b).pos.y>screen height()
      ball(b).collision=1
   else
      ball(b).collision=0
   endif
   if ball(b).collision=1
      ball(b).frc.f2.x=(ball(b).frc.f1.x+ball(b).frc.fd.x+ball(b).frc.fw.x)
      ball(b).frc.f2.y=(ball(b).frc.f1.y+ball(b).frc.fd.y+ball(b).frc.fw.y)
   else
      ball(b).frc.f2.x=0
      ball(b).frc.f2.y=0
   endif
   ball(b).frc.f.x=ball(b).frc.f1.x+ball(b).frc.f2.x+ball(b).frc.fd.x+ball(b).frc.fw.x
   ball(b).frc.f.y=ball(b).frc.f1.y+ball(b).frc.f2.y+ball(b).frc.fd.y+ball(b).frc.fw.y
   ball(b).acc.x=ball(b).frc.f.x/ball(b).mass
   ball(b).acc.y=ball(b).frc.f.y/ball(b).mass
   ball(b).vel.x=ball(b).vel.x+ball(b).acc.x
   ball(b).vel.y=ball(b).vel.y+ball(b).acc.y
      ball(b).vel.m=sqrt(ball(b).vel.x^2+ball(b).vel.y^2)
   ball(b).pos.x=ball(b).pos.x+ball(b).vel.x
   ball(b).pos.y=ball(b).pos.y+ball(b).vel.y

   `draw circle
   ink rgb(255,255,255),0
   circle ball(b).pos.x,ball(b).pos.y,ball(b).size
   `line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(sin(ball(b).ang)*ball(b).size),ball(b).pos.y+(cos(ball(b).ang)*ball(b).size)
   box ball(b).pos.x+((sin(ball(b).ang)*ball(b).size)-2),ball(b).pos.y+((cos(ball(b).ang)*ball(b).size)-2),ball(b).pos.x+((sin(ball(b).ang)*ball(b).size)+2),ball(b).pos.y+((cos(ball(b).ang)*ball(b).size)+2)

   `draw force vectors
   amp#=1
   ink rgb(255,0,0),0
   if spacekey() and shold=0 then shold=1 : showvec=abs(showvec-1)
   if spacekey()=0 then shold=0
   if showvec=1
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f1.x*amp#),ball(b).pos.y+(ball(b).frc.f1.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f2.x*amp#),ball(b).pos.y+(ball(b).frc.f2.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.fd.x*amp#),ball(b).pos.y+(ball(b).frc.fd.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.fw.x*amp#),ball(b).pos.y+(ball(b).frc.fw.y*amp#)
   ink rgb(0,255,0),0
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f.x*amp#),ball(b).pos.y+(ball(b).frc.f.y*amp#)
   endif
next b


`show stuff
ink rgb(255,255,255),0
text 10,10,"Press Space to toggle Force Vectors"


sync
cls
loop


function sign(n as float)
if n>=0 then exitfunction 1
endfunction -1

`2D Physics
sync on : sync rate 60
set display mode 1024,768,32 : `hide mouse

`types
type vec
   x as float
   y as float
   m as float
endtype
type force
   f1 as vec
   f2 as vec
   fw as vec
   fd as vec
   f as vec
endtype
type tscene
   grav as float
   density as float
endtype
scene as tscene
type tball
   pos as vec
   acc as vec
   vel as vec
   mom as vec
   ang as float
   frc as force
   mass as float
   weight as float
   size as float
   drag as float
   collision as boolean
   bmdist as float
endtype

`setup scene
scene.grav=0.0
scene.density=0.0

`create balls
balls=5
dim ball(balls) as tball
for b=1 to balls
   ball(b).pos.x=rnd(screen width())
   ball(b).pos.y=rnd(screen height())
   ball(b).size=rnd(20)+20
   ball(b).mass=rnd(200)+200
   ball(b).weight=ball(b).mass*scene.grav
   ball(b).drag=0.47
next b



`main loop
do

`control balls
for b=1 to balls
   ball(b).bmdist=sqrt((mousex()-ball(b).pos.x)^2+(mousey()-ball(b).pos.y)^2)
   ball(b).frc.f1.x=sin(ball(b).ang)*(ball(b).bmdist/12)
   ball(b).frc.f1.y=cos(ball(b).ang)*(ball(b).bmdist/12)
   ball(b).ang=atanfull(mousex()-ball(b).pos.x,mousey()-ball(b).pos.y)
   ball(b).mom.x=ball(b).mass*ball(b).vel.x : ball(b).mom.y=ball(b).mass*ball(b).vel.y
   ball(b).frc.fd.x=-(ball(b).drag/2)*(ball(b).size*2)*scene.density*((ball(b).vel.x^2)*sign(ball(b).vel.x))
   ball(b).frc.fd.y=-(ball(b).drag/2)*(ball(b).size*2)*scene.density*((ball(b).vel.y^2)*sign(ball(b).vel.y))
   ball(b).frc.fw.y=ball(b).weight
   if ball(b).pos.x<=0 or ball(b).pos.y<=0 or ball(b).pos.x>screen width() or ball(b).pos.y>screen height()
      ball(b).collision=1
   else
      ball(b).collision=0
   endif
   if ball(b).collision=1
      ball(b).frc.f2.x=(ball(b).frc.f1.x+ball(b).frc.fd.x+ball(b).frc.fw.x)
      ball(b).frc.f2.y=(ball(b).frc.f1.y+ball(b).frc.fd.y+ball(b).frc.fw.y)
   else
      ball(b).frc.f2.x=0
      ball(b).frc.f2.y=0
   endif
   ball(b).frc.f.x=ball(b).frc.f1.x+ball(b).frc.f2.x+ball(b).frc.fd.x+ball(b).frc.fw.x
   ball(b).frc.f.y=ball(b).frc.f1.y+ball(b).frc.f2.y+ball(b).frc.fd.y+ball(b).frc.fw.y
   ball(b).acc.x=ball(b).frc.f.x/ball(b).mass
   ball(b).acc.y=ball(b).frc.f.y/ball(b).mass
   ball(b).vel.x=ball(b).vel.x+ball(b).acc.x
   ball(b).vel.y=ball(b).vel.y+ball(b).acc.y
      ball(b).vel.m=sqrt(ball(b).vel.x^2+ball(b).vel.y^2)
   ball(b).pos.x=ball(b).pos.x+ball(b).vel.x
   ball(b).pos.y=ball(b).pos.y+ball(b).vel.y

   `draw circle
   ink rgb(255,255,255),0
   circle ball(b).pos.x,ball(b).pos.y,ball(b).size
   `line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(sin(ball(b).ang)*ball(b).size),ball(b).pos.y+(cos(ball(b).ang)*ball(b).size)
   box ball(b).pos.x+((sin(ball(b).ang)*ball(b).size)-2),ball(b).pos.y+((cos(ball(b).ang)*ball(b).size)-2),ball(b).pos.x+((sin(ball(b).ang)*ball(b).size)+2),ball(b).pos.y+((cos(ball(b).ang)*ball(b).size)+2)

   `draw force vectors
   amp#=1
   ink rgb(255,0,0),0
   if spacekey() and shold=0 then shold=1 : showvec=abs(showvec-1)
   if spacekey()=0 then shold=0
   if showvec=1
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f1.x*amp#),ball(b).pos.y+(ball(b).frc.f1.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f2.x*amp#),ball(b).pos.y+(ball(b).frc.f2.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.fd.x*amp#),ball(b).pos.y+(ball(b).frc.fd.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.fw.x*amp#),ball(b).pos.y+(ball(b).frc.fw.y*amp#)
   ink rgb(0,255,0),0
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f.x*amp#),ball(b).pos.y+(ball(b).frc.f.y*amp#)
   endif
next b


`show stuff
ink rgb(255,255,255),0
text 10,10,"Press Space to toggle Force Vectors"


sync
cls
loop


function sign(n as float)
if n>=0 then exitfunction 1
endfunction -1

REM Project: 2d physics
REM Created: 9/12/2006 4:38:11 PM
REM
REM ***** Main Source File *****
REM
global dim world_lines#(1000,10)
global lines
global diffangle#
global x
global y#
global increase#
global bounce
global poin
cls rgb(255,0,255)
set image colorkey 255,0,255
ink 0,0
for i=1 to 10
   circle 10,10,i
next i
get image 1,0,0,21,21
x=8
for i=1 to 5
world_line(0,250+i,500,300+i)
next i

for i=1 to 5
world_line(550,325+i,350,400+i)
next i

for i=1 to 5
world_line(300,450+i,450,600+i)
next i

for i=1 to 5
world_line(500,700+i,350,900+i)
next i




sync on
sync
do
if rightkey()=1
   x=x+3
   if 0<manage_collision(x,y#) then x=x-3
endif

if leftkey()=1
   x=x-3
   if 0<manage_collision(x,y#) then x=x+3
endif
if upkey()=1
   y#=y#-3
   if 0<manage_collision(x,y#) then y#=y#+3
endif
if downkey()=1
   y#=y#+3
   if 0<manage_collision(x,y#) then y#=y#-3
endif
manage_lines()
paste image 1,x,y#,1
oldx#=x#
oldy#=y#
coll=manage_collision(x,y#)
if coll=0 then gravity(1)
if coll>0 then x= slide_collision(x,y#,coll)
text 0,0,str$(coll)
sync
wait 10
cls rgb(255,255,255)
loop



function world_line(x1#,y1#,x2#,y2#)
   lines=lines+1
   world_lines#(lines,0)=x1#
   world_lines#(lines,1)=x2#
   world_lines#(lines,2)=y1#
   world_lines#(lines,3)=y2#
   world_lines#(lines,4)=(y1#-y2#)/(x1#-x2#)
   world_lines#(lines,5)=y1#-(world_lines#(lines,4)*x1#)
   for i=0 to 5
      text 0,20*i+20,str$(world_lines#(lines,i))
   next i
   sync
   `suspend for key
endfunction

function manage_lines()
   for i=1 to lines
      line world_lines#(i,0),world_lines#(i,2),world_lines#(i,1),world_lines#(i,3)
   next i
endfunction

function manage_collision(x1,y1)
   y1=y1
   for i=1 to lines
      if y1-(world_lines#(i,4)*x1)-world_lines#(i,5)>-2 and y1-(world_lines#(i,4)*x1)-world_lines#(i,5)<2 and y1>world_lines#(i,2) and y1<world_lines#(i,3) then collision=i:goto collisionchecked
   next i
   y1=y1+20
   for i=1 to lines
      if y1-(world_lines#(i,4)*x1)-world_lines#(i,5)>-2 and y1-(world_lines#(i,4)*x1)-world_lines#(i,5)<2 and y1>world_lines#(i,2) and y1<world_lines#(i,3) then collision=i:goto collisionchecked
   next i
   y1=y1-20
   x1=x1+20
   for i=1 to lines
      if y1-(world_lines#(i,4)*x1)-world_lines#(i,5)>-2 and y1-(world_lines#(i,4)*x1)-world_lines#(i,5)<2 and y1>world_lines#(i,2) and y1<world_lines#(i,3) then collision=i:goto collisionchecked
   next i
   y1=y1+20
   for i=1 to lines
      if y1-(world_lines#(i,4)*x1)-world_lines#(i,5)>-2 and y1-(world_lines#(i,4)*x1)-world_lines#(i,5)<2 and y1>world_lines#(i,2) and y1<world_lines#(i,3) then collision=i:goto collisionchecked
   next i
   collisionchecked:
   bounce=0
   if collision>0 and increase#>8 then bounce=1
   if collision>0 and increase#>0 and bounce=0 then increase#=0
endfunction collision

function slide_collision(x1,y1,collision)
   if bounce=0
      neg=1
      regx=x1
      slide:
         if neg=1 then change=change+1:x1=regx+change
         if neg=-1 then x1=regx-change
         neg=neg*-1
         if 0<manage_collision(x1,y1) then goto slide
         if neg=-1 then x1=x1-change+1
         if neg=1 then x1=x1+change-1
         y#=y#+abs(2/change)
   endif
   if bounce=1
      angle#=atan(-1/world_lines#(i,4))
      angle2#=atan((oldy#-y#)/(oldx#-x#))
      diffangle#=tan((angle#-angle2#)-360)
      increase#=-100
   endif
endfunction x1

function gravity(image)
   if increase#<0
      increase#=increase#+1
      if diffangle#<0
         y#=y#+2*diffangle#
         x=x-2
      endif
      if diffangle#>0
         y#=y#-2*diffangle#
         x=x+2
      endif
      if increase#=0 then diffangle#=0
   endif
   if increase#<0.1 and increase#>-1 then increase#=1:y#=y#+increase#
   if increase#>0 and increase#<6 then increase#=increase#*1.01:y#=y#+increase#
   if increase#>=6 then y#=y#+increase#
endfunction

REM Cave Man
REM DBP 6.2
sync on
sync rate 0
Global GRAV as float = .3

type ball
    yforce  as float
    xforce  as float
    bounce  as float
    xbounce as float
    size    as integer
    x       as float
    y       as float
endtype
global daball as ball
daball.xforce = 10
daball.yforce = -10
daball.x = 320
daball.y = 240
daball.bounce = .8
daball.xbounce = .8
daball.size = 10

time = timer()
do
    if timer() - time > 8
        cls 0                
        ink RGB(255,255,255),0
        Circle_Fill(daball.x, daball.y,daball.size)
        RefreshBall()
        sync
        time = timer()
    endif
loop

FUNCTION RefreshBall()
    
    if daball.y + daball.size > screen height()
        daball.yforce = -daball.yforce
        daball.yforce= daball.yforce * daball.bounce
         
        daball.y = screen height() - daball.size
    else
        inc daball.yforce, GRAV
    endif
    inc daball.y, daball.yforce
    
    
    
    if daball.x + daball.size > screen width() or daball.x - daball.size < 0  
         daball.xforce = -daball.xforce
         daball.xforce = daball.xforce * daball.xbounce
         
         inc daball.x, daball.xforce
    endif
    inc daball.x, daball.xforce    
endfunction     

function Circle_Fill(x,y,Radius)
   for x1=0 to Radius
      y1=sqrt(Radius^2-x1^2)
      box x-x1,y-y1,x+x1,y+y1
   next x1
endfunction

function Ellipse_Fill(x,y,xRadius,yRadius)
   for x1=0 to xRadius
      y1=sqrt(xRadius^2-x1^2)*yRadius/(1.0*xRadius)
      box x-x1,y-y1,x+x1,y+y1
   next x1
endfunction

`2D Physics
sync on : sync rate 60
set display mode 1024,768,32 : `hide mouse

`types
type vec
   x as float
   y as float
   m as float
endtype
type force
   f1 as vec
   f2 as vec
   fb as vec
   fw as vec
   fd as vec
   f as vec
endtype
type tscene
   grav as float
   density as float
   wind as vec
endtype
scene as tscene
type tball
   pos as vec
   acc as vec
   vel as vec
   mom as vec
   ang as float
   frc as force
   mass as float
   weight as float
   size as float
   drag as float
   collision as boolean
   bmdist as float
endtype
type tliquid
   size as integer
   damping as float
   elasticity as float
   vsum as float
   fix as float
   fixed as integer
   hleft as float
   hright as float
endtype
liquid as tliquid

`setup scene
scene.grav=0.8
scene.density=0.01
scene.wind.x=0.0
scene.wind.y=0.0

`setup water
liquid.size=150
liquid.damping=0.333
liquid.elasticity=2.0
liquid.fixed=1
makeMatrix2D(1,screen width()+100,liquid.size)
dim lheight(liquid.size) as float
dim lacc(liquid.size) as float
dim lvel(liquid.size) as float
dim lfixed(liquid.size) as boolean
   lfixed(liquid.fixed)=1
for x=1 to liquid.size
    lheight(x)=rnd(300)-150
   for t=1 to 6
      lheight(x)=(lheight(x-1)+lheight(x))/2
   next t
next x

`create balls
balls=3
dim ball(balls) as tball
for b=1 to balls
   ball(b).pos.x=rnd(screen width())
   ball(b).pos.y=rnd(screen height())
   ball(b).size=rnd(20)+20
   ball(b).mass=rnd(50)+50
   ball(b).weight=ball(b).mass*scene.grav
   ball(b).drag=0.47
next b



`main loop
do

`control wind
if upkey() then scene.wind.y=scene.wind.y-1
if downkey() then scene.wind.y=scene.wind.y+1
if leftkey() then scene.wind.x=scene.wind.x-1
if rightkey() then scene.wind.x=scene.wind.x+1

`control balls
for b=1 to balls
   ball(b).bmdist=sqrt((mousex()-ball(b).pos.x)^2+(mousey()-ball(b).pos.y)^2)
   ball(b).frc.f1.x=sin(ball(b).ang)*(ball(b).bmdist/6)
   ball(b).frc.f1.y=cos(ball(b).ang)*(ball(b).bmdist/6)
   ball(b).ang=atanfull(mousex()-ball(b).pos.x,mousey()-ball(b).pos.y)
   ball(b).mom.x=ball(b).mass*ball(b).vel.x : ball(b).mom.y=ball(b).mass*ball(b).vel.y
   ball(b).frc.fd.x=-(ball(b).drag/2)*(ball(b).size*2)*scene.density*((ball(b).vel.x^2)*sign(ball(b).vel.x))
   ball(b).frc.fd.y=-(ball(b).drag/2)*(ball(b).size*2)*scene.density*((ball(b).vel.y^2)*sign(ball(b).vel.y))
   ball(b).frc.fw.y=ball(b).weight
   ball(b).frc.fb.x=scene.wind.x : ball(b).frc.fb.y=scene.wind.y
   if ball(b).pos.x<=0 or ball(b).pos.y<=0 or ball(b).pos.x>screen width() or ball(b).pos.y>screen height()
      ball(b).collision=1
   else
      ball(b).collision=0
   endif
   ball(b).frc.f.x=ball(b).frc.f1.x+ball(b).frc.f2.x+ball(b).frc.fb.x+ball(b).frc.fd.x+ball(b).frc.fw.x
   ball(b).frc.f.y=ball(b).frc.f1.y+ball(b).frc.f2.y+ball(b).frc.fb.y+ball(b).frc.fd.y+ball(b).frc.fw.y
   ball(b).acc.x=ball(b).frc.f.x/ball(b).mass
   ball(b).acc.y=ball(b).frc.f.y/ball(b).mass
   ball(b).vel.x=ball(b).vel.x+ball(b).acc.x
   ball(b).vel.y=ball(b).vel.y+ball(b).acc.y
      ball(b).vel.m=sqrt(ball(b).vel.x^2+ball(b).vel.y^2)
   ball(b).pos.x=ball(b).pos.x+ball(b).vel.x
   ball(b).pos.y=ball(b).pos.y+ball(b).vel.y

   `draw circles
   ink rgb(255,255,255),0
   circle ball(b).pos.x,ball(b).pos.y,ball(b).size
   box ball(b).pos.x+((sin(ball(b).ang)*ball(b).size)-2),ball(b).pos.y+((cos(ball(b).ang)*ball(b).size)-2),ball(b).pos.x+((sin(ball(b).ang)*ball(b).size)+2),ball(b).pos.y+((cos(ball(b).ang)*ball(b).size)+2)

   `draw force vectors
   amp#=1
   ink rgb(255,0,0),0
   if spacekey() and shold=0 then shold=1 : showvec=abs(showvec-1)
   if spacekey()=0 then shold=0
   if showvec=1
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f1.x*amp#),ball(b).pos.y+(ball(b).frc.f1.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f2.x*amp#),ball(b).pos.y+(ball(b).frc.f2.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.fd.x*amp#),ball(b).pos.y+(ball(b).frc.fd.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.fw.x*amp#),ball(b).pos.y+(ball(b).frc.fw.y*amp#)
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.fb.x*amp#),ball(b).pos.y+(ball(b).frc.fb.y*amp#)
   ink rgb(0,255,0),0
   line ball(b).pos.x,ball(b).pos.y,ball(b).pos.x+(ball(b).frc.f.x*amp#),ball(b).pos.y+(ball(b).frc.f.y*amp#)
   endif
next b


`control liquid
ink rgb(0,128,250),0
y#=rnd(300)-150
if lfixed(liquid.fixed)=1
   lheight(liquid.fixed)=y#
endif
for x=2 to liquid.size-1
   if x>1 then liquid.hleft=lheight(x-1)-lheight(x)
   if x<liquid.size then liquid.hright=lheight(x+1)-lheight(x)
   liquid.vsum=liquid.hleft+liquid.hright
   lacc(x)=liquid.vsum*liquid.elasticity
   lvel(x)=lvel(x)+lacc(x)
   lvel(x)=lvel(x)*liquid.damping
   if lfixed(x)=0
      lheight(x)=lheight(x)+lvel(x)
   endif
      setmatrixHeight2D(1,x,lheight(x))
next x
drawMatrix2D(1,-20,screen height()/2)

`show stuff
ink rgb(255,255,255),0
text 10,10,"Press Space to toggle Force Vectors"
text 10,30,"Use the Arrow Keys to Change Wind"
text 10,80,"Wind X: "+str$(scene.wind.x)
text 10,110,"Wind Y: "+str$(scene.wind.y)


sync
cls
loop


function sign(n as float)
if n>=0 then exitfunction 1
endfunction -1

Function MakeMatrix2D(mat,width,Tiles)
   Dim Mat2DTiles(Mat) : Mat2DTiles(Mat)=Tiles
   Dim Mat2DScroll(Mat)
   Dim Mat2DUp(Mat)
   Dim Mat2DW(Mat) : Mat2DW(mat)=width
   Dim Mat2DTileW(Mat) as float : Mat2DTileW(Mat)=Width/Tiles
   Dim Mat2DX(Mat,Tiles) as float
   Dim Mat2DY(Mat,Tiles) as float
   Dim Mat2dL(Mat,Tiles) as boolean
For T=0 to Tiles
   Mat2DX(Mat,T)=T*Mat2DTileW(Mat)
   Mat2DY(Mat,T)=Screen Height()/2
Next T
Endfunction

Function DrawMatrix2D(mat,along,up)
Mat2DScroll(Mat)=along
Mat2DUp(Mat)=up
For T=1 to Mat2DTiles(mat)
   Line Mat2DX(Mat,T-1)+along,Mat2DY(Mat,T-1)+up,Mat2DX(Mat,T)+along,Mat2DY(Mat,T)+up
Next T
Line Mat2DX(Mat,0)+along,Mat2DY(Mat,0)+up,Mat2DX(Mat,0)+along,Screen Height()
Line Mat2DX(Mat,Mat2DTiles(Mat))+along,Mat2DY(Mat,Mat2DTiles(Mat))+up,Mat2DX(Mat,Mat2DTiles(Mat))+along,Screen Height()
Endfunction

Function RandomizeMatrix2D(mat,value)
For T=0 to Mat2DTiles(mat)
if Mat2DL(mat,t)=0
   Mat2DY(mat,T)=(Screen Height()/2)+Rnd(value)
endif
Next T
Endfunction

Function SmoothMatrix2D(mat,amount)
For A=1 to Amount
Dim TH1(Mat2DTiles(mat)-1) : Dim TH2(Mat2DTiles(mat)-1)
For T=1 to Mat2DTiles(mat)-1
if Mat2DL(mat,t)=0
   TH1(T)=Mat2DY(Mat,T-1)
   TH2(T)=Mat2DY(Mat,T+1)
   Mat2DY(Mat,T)=((TH1(T)+TH2(T))/2)
endif
next t
Undim TH1() : Undim TH2()
next A
Endfunction

Function SetMatrixHeight2D(mat,x,height)
if Mat2DL(mat,x)=0
Mat2DY(mat,x)=height
endif
Endfunction

Function LockTile2D(mat,x)
Mat2DL(mat,x)=1
Endfunction
Function UnlockTile2D(mat,x)
Mat2DL(mat,x)=0
Endfunction

Function GetGroundHeight2D(mat,x)
local MT : local Y as float
local YC : local XD
Local Grad as float
For T=1 to Mat2DTiles(Mat)
If X>Mat2DX(Mat,T-1)+Mat2DScroll(Mat) and X<Mat2DX(Mat,T)+Mat2DScroll(Mat)
   on=1
else
   on=0
endif
if on=1
   MT=T : XD=X-(Mat2DX(Mat,MT-1)+Mat2DScroll(Mat))
   TH1=Mat2DY(Mat,MT-1) : TH2=Mat2DY(Mat,MT)
   YC=TH2-TH1
   Grad=YC/Mat2DTileW(Mat)
      Y=int((Grad*XD)+Mat2DY(Mat,MT-1))+Mat2DUp(Mat)
else
   If (X-1)>Mat2DX(Mat,T-1)+Mat2DScroll(Mat) and (X-1)<Mat2DX(Mat,T)+Mat2DScroll(Mat)
      non=1
   else
      non=0
   endif
Endif
if non=1
MT=T : XD=X-(Mat2DX(Mat,MT-1)+Mat2DScroll(Mat))
   TH1=Mat2DY(Mat,MT-1) : TH2=Mat2DY(Mat,MT)
   YC=TH2-TH1
   Grad=YC/Mat2DTileW(Mat)
      Y=(Grad*XD)+Mat2DY(Mat,MT-1)+Mat2DUp(Mat)
   endif
Next T
Endfunction Y

Function GetMatrixHeight2D(mat,x)
t=GetTileNumber2D(mat,x)
height=Mat2DY(mat,t)+Mat2DUp(Mat)
Endfunction height

Function GetTileNumber2D(mat,x)
For T=1 to Mat2DTiles(Mat)
   If X>Mat2DX(Mat,T-1)+Mat2DScroll(Mat) and X<Mat2DX(Mat,T)+Mat2DScroll(Mat)
      on=1
   else
      on=0
   Endif
   if on=1
      MT=T
   else
      If (X-1)>Mat2DX(Mat,T-1)+Mat2DScroll(Mat) and (X-1)<Mat2DX(Mat,T)+Mat2DScroll(Mat)
         MT=T
      Endif
   Endif
   Next T
Endfunction MT

Function GetTileAngle2D(mat,T)
y1=Mat2DY(Mat,T-1)
y2=Mat2DY(Mat,T)
ang#=atanfull(Mat2DTileW(mat),y1-y2)
endfunction ang#

Function GetTileNormalX2D(mat,T)
n#=sin(GetTileAngle2D(mat,T))
endfunction n#
Function GetTileNormalY2D(mat,T)
n#=cos(GetTileAngle2D(mat,T))
endfunction n#

function DrawMatrixNormals2D(mat)
for t=1 to Mat2DTiles(Mat)
x=Mat2DX(Mat,t)-(Mat2DTileW(Mat)/2)+Mat2DScroll(Mat)+(cos(GetTileAngle2D(mat,T))*10)
   line x,GetGroundHeight2D(Mat,x),x,GetGroundHeight2D(Mat,x)-(sin(GetTileAngle2D(mat,T))*10)
next t
endfunction

Function GetTileHardness2D(mat,x)
h=Mat2DL(mat,x)
Endfunction h

sync on
sync rate 0
cls
set display mode 1024,768,32
autocam off
position camera 0,0,-100
set camera range 50,150
rotate camera 0,0,0
color backdrop 0

global max_body_amount=500
global max_vertex_amount=20
global max_collision_data_amount=500
global max_material_amount=20


type xy
   x as float
   y as float
endtype
type xyw
   x as float
   y as float
   w as float
endtype
type body_type
   p as xyw
   v as xyw
   force as xyw
   impulse as xyw
   mass as float
   moi as float
   vertex_amount
   push as xyw
   exist as boolean
   gravity as boolean
   active as boolean
   autofreeze as boolean
   object
   lin_damp as float
   ang_damp as float
   collision_radius as float
   material
endtype
type collision_data_type
   vertex_amount
   exist as boolean
endtype
type world_type
   min as xy
   max as xy
   onexit
endtype
type collision_type
   pt as xy
   n as xy
   distance as float
   body
   edge
   edge_length as float
   point_amount
   exist as boolean
endtype
type rbd_type
   world as world_type
   last_time
   collision as collision_type
endtype
type material_type
   sfriction as float
   kfriction as float
   elasticity as float
   collidable as boolean
endtype

dim body(max_body_amount) as body_type
dim body_shape(max_body_amount,max_vertex_amount) as xy
dim collision_data(max_collision_data_amount+2) as collision_data_type
dim collision_data_v(max_collision_data_amount,max_vertex_amount) as xy
dim material(max_material_amount,max_material_amount) as material_type
dim groupid(max_material_amount)
global RBD as rbd_type
global RBD_V1=1
global RBD_V2=2
global RBD_V3=3
global RBD_V4=4
global RBD_V5=5
global RBD_V6=6
n=make vector2(RBD_V1)
n=make vector2(RBD_V2)
n=make vector2(RBD_V3)
n=make vector2(RBD_V4)
n=make vector2(RBD_V5)
n=make vector2(RBD_V6)
RBD_Create()
n=0
for y=1 to 3
for x=1 to 4
inc n
sx#=5*(rnd(3)+1)
sy#=5*(rnd(3)+1)
col=RBD_CreateBox(sx#,sy#)
make object box n,sx#,sy#,0.1
color object n,rgb(rnd(255),rnd(255),rnd(255))
b=RBD_CreateBody(col)
mass#=sx#*sy#
moi#=RBD_CalculateMIBoxSolid(mass#,sx#,sy#)
RBD_BodySetMass(b,mass#,moi#)
RBD_BodySetDBProData(b, n)
body(b).p.y=20*(y-1)-55
body(b).p.x=20.0*(x-2.5)
next x
next y
n=n+1
col=RBD_CreateBox(200.0,5.0)
make object plain n,200.0,5.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).mass=0
body(b).p.y=-60
body(b).p.w=0
body(b).p.x=0
inc n
make object plain n,200.0,5.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).p.w=90
body(b).p.x=-80
body(b).p.y=0
body(b).mass=0
inc n
make object plain n,200.0,5.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).p.w=0
body(b).p.x=0
body(b).p.y=60
body(b).mass=0
inc n
make object plain n,200.0,5.0
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).p.w=90
body(b).p.x=80
body(b).p.y=0
body(b).mass=0
inc n
col=RBD_CreateBox(80.0,5.0)
make object plain n,80.0,5.0
bar=n
b=RBD_CreateBody(col)
RBD_BodySetDBProData(b, n)
body(b).mass=0
body(b).p.y=20
body(b).p.w=0
body(b).p.x=0
inc n
global time# as float
drag_body=-1
grabx#=0
graby#=0
global screen=10000
make object plain screen,10000,10000
position object screen,0,0,2
color object screen,0
set object light screen,0
ghost object on screen,1
`hide object screen
global dummy_obj=10001
make object cube dummy_obj,0
do
   time#=RBD_GetElapsedTimeInSec()
   RBD_Update(time#)
   set cursor 0,0
   print "FPS:",screen fps()
   set vector2 RBD_V1,0,1
   set vector2 RBD_V2,0,30*(upkey()-downkey())
   RBD_BodyAddForceLocal(body1)
   set vector2 RBD_V1,-(rightkey()-leftkey())*200.0,0
   RBD_BodyAddTorque(body1)
   body(RBD_GetBody(bar)).v.w=leftkey()-rightkey()
   if mouseclick()=1 and drag_body=-1
      obj=pick object(mousex(),mousey(),1,100)
      b=RBD_GetBody(obj)
      if b>=0
         if body(b).mass>0
            drag_body=b
            set vector2 RBD_V1,get pick vector x()+camera position x(),get pick vector y()+camera position y()
            set vector2 RBD_V1,x vector2(RBD_V1)-body(b).p.x,y vector2(RBD_V1)-body(b).p.y
            rotate_vector2(RBD_V1,-body(b).p.w)
            grabx#=x vector2(RBD_V1)
            graby#=y vector2(RBD_V1)
         endif
      endif
   endif
   print "Selected body:",last_body
   print "Velocity:",str$(body(last_body).v.x,2),",",str$(body(last_body).v.y,2)
   print "Angular Velocity:",str$(body(last_body).v.w,2)
   print "Mass:",str$(body(last_body).mass,2)
   print "Moment of Inertia:",str$(body(last_body).moi,2)
   if mouseclick()=0 then drag_body=-1
   if drag_body>=0
      obj=pick object(mousex(),mousey(),screen,screen)
      set vector2 RBD_V1,grabx#,graby#
      rotate_vector2(RBD_V1,body(drag_body).p.w)
      set vector2 RBD_V1,x vector2(RBD_V1)+body(drag_body).p.x,y vector2(RBD_V1)+body(drag_body).p.y
      dx#=get pick vector x()+camera position x()-x vector2(RBD_V1)
      dy#=get pick vector y()+camera position y()-y vector2(RBD_V1)
      d2#=dx#^2+dy#^2
      d#=sqrt(d2#)
      dx#=dx#/d#
      dy#=dy#/d#
      force#=body(drag_body).mass*(d2#)
      set vector2 RBD_V2,force#*dx#,force#*dy#
      RBD_BodyAddForceGlobal(b)
      line mousex(),mousey(),screenx(x vector2(RBD_V1)),screeny(y vector2(RBD_V1))
      body(drag_body).v.x=body(drag_body).v.x*0.98
      body(drag_body).v.y=body(drag_body).v.y*0.98
      body(drag_body).v.w=body(drag_body).v.w*0.98
      last_body=drag_body
   endif
   if shiftkey()=1
      body(last_body).v.x=0
      body(last_body).v.y=0
      if keystate(30)=1
         for b=0 to max_body_amount
            body(b).v.x=0
            body(b).v.y=0
            body(b).force.x=0
            body(b).force.y=0
         next b
      endif
   endif
   if controlkey()=1
      body(last_body).v.w=0
      if keystate(30)=1
         for b=0 to max_body_amount
            body(b).v.w=0
            body(b).force.w=0
         next b
      endif
   endif
   if keystate(34)=1 and key34=0
      key34=1
      body(last_body).gravity=1-body(last_body).gravity
   endif
   key34=keystate(34)
   sync
loop

function RBD_Create()
   RBD.world.min.x=-100.0
   RBD.world.max.x=100.0
   RBD.world.min.y=-100.0
   RBD.world.max.y=100.0
   RBD.last_time=timer()
   RBD.world.onexit=0
   local b
   for b=0 to max_body_amount
      body(b).exist=0
   next b
   material(0,0).collidable=1
   material(0,0).elasticity=0.3
   material(0,0).sfriction=0.4
   material(0,0).kfriction=0.4
   groupid(0)=1
endfunction

function RBD_Update(time#)
   for b=0 to max_body_amount
      if body(b).exist=1
         if RBD.world.onexit=1
            if body(b).p.x<RBD.world.min.x or body(b).p.y<RBD.world.min.y or body(b).p.x>RBD.world.max.x or body(b).p.y>RBD.world.max.y then body(b).exist=0
         endif
         body(b).force.x=body(b).force.x-body(b).lin_damp*body(b).v.x*abs(body(b).v.x)*time#
         body(b).force.y=body(b).force.y-body(b).lin_damp*body(b).v.y*abs(body(b).v.y)*time#
         body(b).force.w=body(b).force.w*0.995-body(b).ang_damp*body(b).v.w*abs(body(b).v.w)*time#
`         if body(b).mass>0
`         else
`            body(b).v.x=0
`            body(b).v.y=0
`            body(b).v.w=0
`         endif
            body(b).v.x=body(b).v.x+body(b).force.x/body(b).mass*time#+body(b).impulse.x/body(b).mass
            body(b).v.y=body(b).v.y+body(b).force.y/body(b).mass*time#+body(b).impulse.y/body(b).mass
            body(b).v.w=body(b).v.w+body(b).force.w/body(b).moi*time#+body(b).impulse.w/body(b).moi
            body(b).p.x=body(b).p.x+body(b).push.x
            body(b).p.y=body(b).p.y+body(b).push.y
            body(b).p.w=body(b).p.w+body(b).push.w


         body(b).force.x=0
         body(b).force.y=0-98*body(b).mass*body(b).gravity
         body(b).force.w=0
         body(b).impulse.x=0
         body(b).impulse.y=0
         body(b).impulse.w=0
         body(b).push.x=0
         body(b).push.y=0
         body(b).push.w=0
         body(b).p.x=body(b).p.x+body(b).v.x*time#
         body(b).p.y=body(b).p.y+body(b).v.y*time#
         body(b).p.w=body(b).p.w+body(b).v.w*time#*180.0/3.14159
         if body(b).object>0
            position object body(b).object,curvevalue(body(b).p.x,object position x(body(b).object),1.5),curvevalue(body(b).p.y,object position y(body(b).object),1.5),0
            rotate object body(b).object,0,0,curveangle(body(b).p.w,object angle z(body(b).object),1.5)
         endif
         for l=1 to 3
         for b2=0 to max_body_amount
            if body(b2).exist=1
               mat1=body(b).material
               mat2=body(b2).material
               if mat2<mat1
                  t=mat1
                  mat1=mat2
                  mat2=t
               endif
               if b<>b2 and material(mat1,mat2).collidable=1 and body(b).mass>0
                  d2#=(body(b).p.x-body(b2).p.x)^2+(body(b).p.y-body(b2).p.y)^2
                  if d2#<(body(b).collision_radius+body(b2).collision_radius)^2
                     col=BodyCollision(b,b2)
                     if col=1
                        position object dummy_obj,RBD.collision.pt.x,RBD.collision.pt.y,0
                        cx=object screen x(dummy_obj)
                        cy=object screen y(dummy_obj)
                        position object dummy_obj,RBD.collision.pt.x+2.0*RBD.collision.n.x*RBD.collision.distance,RBD.collision.pt.y+2.0*RBD.collision.n.y*RBD.collision.distance,0
                        dx=object screen x(dummy_obj)
                        dy=object screen y(dummy_obj)
                       ` line cx,cy,dx,dy
                        nx#=RBD.collision.n.x
                        ny#=RBD.collision.n.y
                        rAPx#=RBD.collision.pt.x-body(b).p.x
                        rAPy#=RBD.collision.pt.y-body(b).p.y
                        rAP#=sqrt(rAPx#^2+rAPy#^2)
                        rBPx#=RBD.collision.pt.x-body(b2).p.x
                        rBPy#=RBD.collision.pt.y-body(b2).p.y
                        rBP#=sqrt(rx#^2+ry#^2)
                        rTAPx#=-rAPy#/rAP#
                        rTAPy#=rAPx#/rAP#
                        rTBPx#=-rBPy#/rBP#
                        rTBPy#=rBPx#/rBP#
                        vA1x#=body(b).v.x
                        vA1y#=body(b).v.y
                        wA1#=body(b).v.w
                        vAP1x#=vA1x#+wA1#*rTAPx#
                        vAP1y#=vA1y#+wA1#*rTAPy#
                        vB1x#=body(b2).v.x
                        vB1y#=body(b2).v.y
                        wB1#=body(b2).v.w
                        vBP1x#=vB1x#+wB1#*rTBPx#
                        vBP1y#=vB1y#+wB1#*rTBPy#
                        vAB1x#=vBP1x#-vAP1x#
                        vAB1y#=vBP1y#-vAP1y#
                        vAB1#=vAB1x#*nx#+vAB1y#*ny#

                        frictionnx#=-RBD.collision.n.y
                        frictionny#=RBD.collision.n.x
                        frictionrAPx#=RBD.collision.pt.x-body(b).p.x
                        frictionrAPy#=RBD.collision.pt.y-body(b).p.y
                        frictionrAP#=sqrt(frictionrAPx#^2+frictionrAPy#^2)
                        frictionrBPx#=RBD.collision.pt.x-body(b2).p.x
                        frictionrBPy#=RBD.collision.pt.y-body(b2).p.y
                        frictionrBP#=sqrt(frictionrx#^2+frictionry#^2)
                        frictionrTAPx#=-frictionrAPy#/frictionrAP#
                        frictionrTAPy#=frictionrAPx#/frictionrAP#
                        frictionrTBPx#=-frictionrBPy#/frictionrBP#
                        frictionrTBPy#=frictionrBPx#/frictionrBP#
                        frictionvA1x#=body(b).v.x
                        frictionvA1y#=body(b).v.y
                        frictionwA1#=body(b).v.w
                        frictionvAP1x#=frictionvA1x#+frictionwA1#*frictionrTAPx#
                        frictionvAP1y#=frictionvA1y#+frictionwA1#*frictionrTAPy#
                        frictionvB1x#=body(b2).v.x
                        frictionvB1y#=body(b2).v.y
                        frictionwB1#=body(b2).v.w
                        frictionvBP1x#=frictionvB1x#+frictionwB1#*frictionrTBPx#
                        frictionvBP1y#=frictionvB1y#+frictionwB1#*frictionrTBPy#
                        frictionvAB1x#=frictionvBP1x#-frictionvAP1x#
                        frictionvAB1y#=frictionvBP1y#-frictionvAP1y#
                        frictionvAB1#=frictionvAB1x#*frictionnx#+frictionvAB1y#*frictionny#


                        e#=material(mat1,mat2).elasticity
                        if l=1
                           j#=(VAB1x#*nx#+VAB1y#*ny#)/((nx#*nx#+ny#*ny#)*(1.0/body(b).mass+1.0/body(b2).mass)+(rTAPx#*nx#+rTAPy#*ny#)^2/body(b).moi +(rTBPx#*nx#+rTBPy#*ny#)^2/body(b2).moi)
                           frictionj#=(frictionVAB1x#*frictionnx#+frictionVAB1y#*frictionny#)/((frictionnx#*frictionnx#+frictionny#*frictionny#)*(1.0/body(b).mass+1.0/body(b2).mass)+(frictionrTAPx#*frictionnx#+frictionrTAPy#*frictionny#)^2/body(b).moi +(frictionrTBPx#*frictionnx#+frictionrTBPy#*frictionny#)^2/body(b2).moi)
                           if j#<-0.1
                              j#=j#*(1.0+e#)
                           else
                              j#=j#*(1.0+e#/10.0)
`                              if vAB1#>-0.1
 `                                j#=j#
``                              else
``                                 j#=-j#*0.9
`                              endif
                           endif
                           if abs(frictionj#)> abs(j#)*material(mat1,mat2).kfriction
                              frictionj#=frictionj#/abs(frictionj#)*abs(j#)*material(mat1,mat2).kfriction
                           endif

                           if body(b2).mass=0 then j#=2*j#
                           ivA2x#=(j#)*nx#
                           ivA2y#=(j#)*ny#
                           ivB2x#=-(j#)*nx#
                           ivB2y#=-(j#)*ny#
                           iwA2#=(rTAPx#*j#*nx#+rTAPy#*j#*ny#)
                           iwB2#=(rTBPx#*j#*nx#+rTBPy#*j#*ny#)
                           frictionivA2x#=(frictionj#)*frictionnx#
                           frictionivA2y#=(frictionj#)*frictionny#
                           frictionivB2x#=-(frictionj#)*frictionnx#
                           frictionivB2y#=-(frictionj#)*frictionny#
                           frictioniwA2#=(frictionrTAPx#*frictionj#*frictionnx#+frictionrTAPy#*frictionj#*frictionny#)
                           frictioniwB2#=(frictionrTBPx#*frictionj#*frictionnx#+frictionrTBPy#*frictionj#*frictionny#)

                           k#=0.5
                           body(b).impulse.x=body(b).impulse.x+ivA2x#*k#+frictionivA2x#*k#
                           body(b).impulse.y=body(b).impulse.y+ivA2y#*k#+frictionivA2y#*k#
                           body(b).impulse.w=body(b).impulse.w+iwA2#*k#+frictioniwA2#*k#
                           body(b2).impulse.x=body(b2).impulse.x+ivB2x#*k#+frictionivB2x#*k#
                           body(b2).impulse.y=body(b2).impulse.y+ivB2y#*k#+frictionivB2y#*k#
                           body(b2).impulse.w=body(b2).impulse.w+iwB2#*k#+frictioniwB2#*k#
                        endif
                        if body(b).mass>0
                           if body(b2).mass=0
                              body(b).p.x=body(b).p.x+RBD.collision.distance*(RBD.collision.n.x)
                              body(b).p.y=body(b).p.y+RBD.collision.distance*(RBD.collision.n.y)
                              body(b2).force.x=0
                              body(b2).force.y=0
                              body(b2).force.w=0
                           else
                              body(b).p.x=body(b).p.x+RBD.collision.distance*(RBD.collision.n.x)*body(b).mass/(body(b).mass+body(b2).mass)*0.999
                              body(b).p.y=body(b).p.y+RBD.collision.distance*(RBD.collision.n.y)*body(b).mass/(body(b).mass+body(b2).mass)*0.999
                              body(b2).p.x=body(b2).p.x-RBD.collision.distance*(RBD.collision.n.x)*body(b).mass/(body(b).mass+body(b2).mass)*0.999
                              body(b2).p.y=body(b2).p.y-RBD.collision.distance*(RBD.collision.n.y)*body(b).mass/(body(b).mass+body(b2).mass)*0.999
                           endif
                        endif
                        `endif
                     endif
                  endif
               endif
            endif
         next b2
         next l
         if body(b).p.y<-70 then body(b).p.y=70
         if body(b).p.y>70 then body(b).p.y=-70
         if body(b).p.x<-90 then body(b).p.x=90
         if body(b).p.x>90 then body(b).p.x=-90
      endif
   next b
   local c
   for c=0 to max_collision_data_amount
      collision_data(c).exist=0
   next c
endfunction

function RBD_GetElapsedTimeInSec()
   t#=(timer()-RBD.last_time)*0.001
   RBD.last_time=timer()
   if t#<0.001 then t#=0.001
endfunction t#

function RBD_SetWorldSize()
   RBD.world.min.x=x vector2(RBD_V1)
   RBD.world.min.y=y vector2(RBD_V1)
   RBD.world.max.x=x vector2(RBD_V2)
   RBD.world.max.y=y vector2(RBD_V2)
endfunction

function RBD_CreateBox(sx#,sy#)
   local c=0
   while collision_data(c).exist=1
      inc c
   endwhile
   collision_data(c).exist=1
   collision_data(c).vertex_amount=4
   collision_data_v(c,0).x=sx#*0.5
   collision_data_v(c,0).y=sy#*0.5

   collision_data_v(c,1).x=sx#*0.5
   collision_data_v(c,1).y=-sy#*0.5

   collision_data_v(c,2).x=-sx#*0.5
   collision_data_v(c,2).y=-sy#*0.5

   collision_data_v(c,3).x=-sx#*0.5
   collision_data_v(c,3).y=sy#*0.5
endfunction c

function RBD_CreateBody(col)
   local b=0
   while body(b).exist=1
      inc b
   endwhile
   body(b).exist=1
   body(b).p.x=0
   body(b).p.y=0
   body(b).p.w=0
   body(b).v.x=0
   body(b).v.y=0
   body(b).v.w=0
   body(b).force.x=0
   body(b).force.y=0
   body(b).force.w=0
   body(b).impulse.x=0
   body(b).impulse.y=0
   body(b).impulse.w=0
   body(b).mass=1
   body(b).moi=1
   body(b).gravity=1
   body(b).active=1
   body(b).autofreeze=1
   body(b).lin_damp=0.1
   body(b).ang_damp=0.1
   body(b).vertex_amount=collision_data(col).vertex_amount
   body(b).material=0
   local v
   rad2#=0
   for v=0 to body(b).vertex_amount-1
      body_shape(b,v).x=collision_data_v(col,v).x
      body_shape(b,v).y=collision_data_v(col,v).y
      r#=collision_data_v(col,v).x^2+collision_data_v(col,v).y^2
      if r#>rad2#
         rad2#=r#
      endif
   next v
   body(b).collision_radius=sqrt(rad2#)
endfunction b

function RBD_DestroyBody(b)
   body(b).exist=0
endfunction

function RBD_BodyGetRotation(b)
   set vector2 RBD_V1,body(b).p.w,0
endfunction

function RBD_BodyGetPosition(b)
   set vector2 RBD_V1,body(b).p.x,body(b).p.y
endfunction

function RBD_DestroyAllBodies()
   local b
   for b=0 to max_body_amount
      RBD_DestroyBody(b)
   next b
endfunction

function RBD_SetBodyLeaveWorldEvent(flag)
   RBD.world.onexit=flag
endfunction

function RBD_BodySetDBProData(body, db_num)
   body(body).object=db_num
endfunction

function RBD_BodySetVelocity(body)
   body(body).v.x=x vector2(RBD_V1)
   body(body).v.y=y vector2(RBD_V1)
endfunction

function RBD_BodyGetVelocity(body)
   set vector2 RBD_V1,body(body).v.x,body(body).v.y
endfunction

function RBD_BodySetOmega(body)
   body(body).v.w=x vector2(RBD_V1)
endfunction

function RBD_BodyGetOmega(body)
   set vector2 RBD_V1,body(body).v.w,0
endfunction

function RBD_BodySetLinearDamping(body, lin_damp#)
   body(body).lin_damp=lin_damp#
endfunction

function RBD_BodyGetLinearDamping(body)
d#=body(body).lin_damp
endfunction d#

function RBD_BodySetAngularDamping(body, ang_damp#)
   body(body).ang_damp=ang_damp#
endfunction

function RBD_BodyGetAngularDamping(body)
d#=body(body).ang_damp
endfunction d#


function RBD_BodyAddTorque(body)
   body(body).force.w=body(body).force.w+x vector2(RBD_V1)
endfunction

function RBD_BodySetTorque(body)
   body(body).force.w=x vector2(RBD_V1)
endfunction

function RBD_BodyAddForceGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)
   R#=sqrt(RX#^2+RY#^2)
   body(b).force.w=body(b).force.w+torque#
   body(b).force.x=body(b).force.x+FX#*abs(RX#/R#)
   body(b).force.y=body(b).force.y+FY#*abs(RY#/R#)
endfunction

function RBD_BodyAddForceLocal(b)
   rotate_vector2(RBD_V1,body(b).p.w)
   set vector2 RBD_V1,x vector2(RBD_V1)+body(b).p.x,y vector2(RBD_V1)+body(b).p.y
   rotate_vector2(RBD_V2,body(b).p.w)
   RBD_BodyAddForceGlobal(b)
endfunction

function RBD_BodySetForceGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   torque#=(RX#*FY#-RY#*FX#)
   body(b).force.w=torque#
   R#=sqrt(RX#^2+RY#^2)
   body(b).force.x=FX#*abs(RX#/R#)
   body(b).force.y=FY#*abs(RY#/R#)
endfunction


function RBD_BodySetForceLocal(b)
   rotate_vector2(RBD_V1,body(b).p.w)
   set vector2 RBD_V1,x vector2(RBD_V1)+body(b).p.x,y vector2(RBD_V1)+body(b).p.y
   rotate_vector2(RBD_V2,body(b).p.w)
   RBD_BodySetForceGlobal(b)
endfunction

function RBD_BodyAddImpulseGlobal(b)
   RX#=x vector2(RBD_V1)-body(b).p.x
   RY#=y vector2(RBD_V1)-body(b).p.y
   FX#=x vector2(RBD_V2)
   FY#=y vector2(RBD_V2)
   R#=sqrt(RX#^2+RY#^2)
   torque#=(RX#*FY#-RY#*FX#)
   body(b).impulse.w=body(b).impulse.w+torque#/R#^2
   body(b).impulse.x=body(b).impulse.x+FX#*abs(RX#/R#)
   body(b).impulse.y=body(b).impulse.y+FY#*abs(RY#/R#)
endfunction

function RBD_BodyAddImpulseLocal(b)
   rotate_vector2(RBD_V1,body(b).p.w)
   set vector2 RBD_V1,x vector2(RBD_V1)+body(b).p.x,y vector2(RBD_V1)+body(b).p.y
   rotate_vector2(RBD_V2,body(b).p.w)
   RBD_BodyAddImpulseGlobal(b)
endfunction

function rotate_vector2(v,r#)
   set vector2 RBD_V3,cos(r#),sin(r#)
   set vector2 RBD_V4,-y vector2(RBD_V3),x vector2(RBD_V3)
   set vector2 v,x vector2(v)*x vector2(RBD_V3)+y vector2(v)*x vector2(RBD_V4),x vector2(v)*y vector2(RBD_V3)+y vector2(v)*y vector2(RBD_V4)
endfunction

function BodyCollision(b1,b2)
   if body(b2).vertex_amount<body(b1).vertex_amount
      bt=b1
      b1=b2
      b2=bt
   endif
   va1=body(b1).vertex_amount
   va2=body(b2).vertex_amount
   RBD.collision.distance=100000
   RBD.collision.exist=0
   RBD.collision.point_amount=0
   for v=0 to va1-1
      vx#=body_shape(b1,mod((v+1),(va1))).x-body_shape(b1,v).x
      vy#=body_shape(b1,mod((v+1),(va1))).y-body_shape(b1,v).y
      set vector2 RBD_V1,vx#,vy#
      length#=length vector2(RBD_V1)
      normalize vector2 RBD_V1,RBD_V1
      rotate_vector2(RBD_V1,body(b1).p.w+90)
      nx#=x vector2(RBD_V1)
      ny#=y vector2(RBD_V1)
      minv1#=100000
      minv1=0
      maxv1#=-100000
      maxv1=0
      minv2#=100000
      minv2=0
      maxv2#=-100000
      maxv2=0
      for v1=0 to va1-1
         set vector2 RBD_V2,body_shape(b1,v1).x,body_shape(b1,v1).y
         rotate_vector2(RBD_V2,body(b1).p.w)
         set vector2 RBD_V2,x vector2(RBD_V2)+body(b1).p.x,y vector2(RBD_V2)+body(b1).p.y
         v1#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
         if v1#<minv1#
            minv1#=v1#
            minv1=v1
         endif
         if v1#>maxv1#
            maxv1#=v1#
            maxv1=v1
         endif
      next v1
      for v2=0 to va2-1
         good=1
         remstart
         vx#=body_shape(b2,mod((v2+1),(va2))).x-body_shape(b2,v2).x
         vy#=body_shape(b2,mod((v2+1),(va2))).y-body_shape(b2,v2).y
         set vector2 RBD_V5,vx#,vy#
         length2#=length vector2(RBD_V5)
         rotate_vector2(RBD_V5,body(b2).p.w-90)
         normalize vector2 RBD_V5,RBD_V5
         nx2#=x vector2(RBD_V5)
         ny2#=y vector2(RBD_V5)
         if abs(nx#-nx2#)<0.01 and abs(ny#-ny2#)<0.01
            if length2#>length# then good=0
         endif
         vx#=body_shape(b2,mod((v2-1),(va2))).x-body_shape(b2,v2).x
         vy#=body_shape(b2,mod((v2-1),(va2))).y-body_shape(b2,v2).y
         set vector2 RBD_V5,vx#,vy#
         length2#=length vector2(RBD_V5)
         rotate_vector2(RBD_V5,body(b2).p.w-90)
         normalize vector2 RBD_V5,RBD_V5
         nx2#=x vector2(RBD_V5)
         ny2#=y vector2(RBD_V5)
         if abs(nx#-nx2#)<0.01 and abs(ny#-ny2#)<0.01
            if length2#>length# then  good=0
         endif
         remend
         if good=1
            set vector2 RBD_V2,body_shape(b2,v2).x,body_shape(b2,v2).y
            rotate_vector2(RBD_V2,body(b2).p.w)
            set vector2 RBD_V2,x vector2(RBD_V2)+body(b2).p.x,y vector2(RBD_V2)+body(b2).p.y
            v2#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
            if v2#<minv2#
               minv2#=v2#
               minv2=v2
            endif
            if v2#>maxv2#
               maxv2#=v2#
               maxv2=v2
            endif
         endif
      next v2
      if maxv1#-0.000<=minv2# or maxv2#-0.000<=minv1#
         exitfunction 0
      else
         if maxv2#>maxv1#
            d#=maxv1#-minv2#
            cv=minv2
            if d#>0
               if d#<=RBD.collision.distance-0.01
                  RBD.collision.distance=d#
                  RBD.collision.body=b1
                  RBD.collision.edge=v
                  RBD.collision.edge_length=length#
                  RBD.collision.exist=1
               else
                  if abs(d#-RBD.collision.distance)>0.01
                     if length#<RBD.collision.edge_length
                        RBD.collision.distance=d#
                        RBD.collision.body=b1
                        RBD.collision.edge=v
                        RBD.collision.edge_length=length#
                        RBD.collision.exist=1
                     endif
                  endif
               endif

            endif
         endif
      endif
   next v
   for v=0 to va2-1
      vx#=body_shape(b2,mod((v+1),(va2))).x-body_shape(b2,v).x
      vy#=body_shape(b2,mod((v+1),(va2))).y-body_shape(b2,v).y

      set vector2 RBD_V1,vx#,vy#
      length#=length vector2(RBD_V1)
      normalize vector2 RBD_V1,RBD_V1
      rotate_vector2(RBD_V1,body(b2).p.w+90)
      nx#=x vector2(RBD_V1)
      ny#=y vector2(RBD_V1)

      minv1#=100000
      minv1=0
      maxv1#=-100000
      maxv1=0
      minv2#=100000
      minv2=0
      maxv2#=-100000
      maxv2=0

      for v1=0 to va1-1
         good=1
         remstart
         vx#=body_shape(b1,mod((v1+1),(va1))).x-body_shape(b1,v1).x
         vy#=body_shape(b1,mod((v1+1),(va1))).y-body_shape(b1,v1).y
         set vector2 RBD_V5,vx#,vy#
         length2#=length vector2(RBD_V5)
         normalize vector2 RBD_V5,RBD_V5
         rotate_vector2(RBD_V5,body(b1).p.w-90)
         nx2#=x vector2(RBD_V5)
         ny2#=y vector2(RBD_V5)
         if abs(nx#-nx2#)<0.01 and abs(ny#-ny2#)<0.01
            if length2#>length# then good=0
         endif
         vx#=body_shape(b1,mod((v1-1),(va1))).x-body_shape(b1,v1).x
         vy#=body_shape(b1,mod((v1-1),(va1))).y-body_shape(b1,v1).y
         set vector2 RBD_V5,vx#,vy#
         length2#=length vector2(RBD_V5)
         normalize vector2 RBD_V5,RBD_V5
         rotate_vector2(RBD_V5,body(b1).p.w-90)
         nx2#=x vector2(RBD_V5)
         ny2#=y vector2(RBD_V5)
         if abs(nx#-nx2#)<0.01 and abs(ny#-ny2#)<0.01
            if length2#>length# then good=0
         endif
         remend
         if good=1
            set vector2 RBD_V2,body_shape(b1,v1).x,body_shape(b1,v1).y
            rotate_vector2(RBD_V2,body(b1).p.w)
            set vector2 RBD_V2,x vector2(RBD_V2)+body(b1).p.x,y vector2(RBD_V2)+body(b1).p.y
            v1#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
            if v1#<minv1#
               minv1#=v1#
               minv1=v1
            endif
            if v1#>maxv1#
               maxv1#=v1#
               maxv1=v1
            endif
         endif
      next v1
      for v2=0 to va2-1
         set vector2 RBD_V2,body_shape(b2,v2).x,body_shape(b2,v2).y
         rotate_vector2(RBD_V2,body(b2).p.w)
         set vector2 RBD_V2,x vector2(RBD_V2)+body(b2).p.x,y vector2(RBD_V2)+body(b2).p.y
         v2#=x vector2(RBD_V2)*x vector2(RBD_V1)+y vector2(RBD_V2)*y vector2(RBD_V1)
         if v2#<minv2#
            minv2#=v2#
            minv2=v2
         endif
         if v2#>maxv2#
            maxv2#=v2#
            maxv2=v2
         endif
      next v2
      if  maxv1#-0.000<=minv2# or maxv2#-0.0001=minv1#
         exitfunction 0
      else
         if maxv1#>maxv2#
            d#=maxv2#-minv1#
            cv=minv1
            if d#>0

               if d#<=RBD.collision.distance-0.01
                  RBD.collision.distance=d#
                  RBD.collision.body=b2
                  RBD.collision.edge=v
                  RBD.collision.edge_length=length#
                  RBD.collision.exist=1
               else
                  if abs(d#-RBD.collision.distance)<0.01
                     if length#>RBD.collision.edge_length
                        RBD.collision.distance=d#
                        RBD.collision.body=b2
                        RBD.collision.edge=v
                        RBD.collision.edge_length=length#
                        RBD.collision.exist=1
                     endif
                  endif
               endif
            endif
         endif
      endif
   next v
   if RBD.collision.exist=1
      b=RBD.collision.body
      if b=b1 then bother=b2 else bother=b1
      maxd#=0
      v=RBD.collision.edge
      vx#=body_shape(b,mod((v+1),body(b).vertex_amount)).x-body_shape(b,v).x
      vy#=body_shape(b,mod((v+1),body(b).vertex_amount)).y-body_shape(b,v).y
      set vector2 RBD_V1,vx#,vy#
      length#=length vector2(RBD_V1)
      normalize vector2 RBD_V1,RBD_V1
      rotate_vector2(RBD_V1,body(b).p.w)
      tx#=x vector2(RBD_V1)
      ty#=y vector2(RBD_V1)
      rotate_vector2(RBD_V1,-90)
      nx#=x vector2(RBD_V1)
      ny#=y vector2(RBD_V1)
      set vector2 RBD_V5,body_shape(b,v).x,body_shape(b,v).y
      rotate_vector2(RBD_V5,body(b).p.w)
      set vector2 RBD_V5,x vector2(RBD_V5)+body(b).p.x,y vector2(RBD_V5)+body(b).p.y
      `line screenx(x vector2(RBD_V5)),screeny(y vector2(RBD_V5)),screenx(x vector2(RBD_V5)+tx#*40.0),screeny(y vector2(RBD_V5)+ty#*40.0)
      `line screenx(x vector2(RBD_V5)),screeny(y vector2(RBD_V5)),screenx(x vector2(RBD_V5)+nx#*20.0),screeny(y vector2(RBD_V5)+ny#*20.0)
      `circle screenx(x vector2(RBD_V5)),screeny(y vector2(RBD_V5)),15
      set vector2 RBD_V1,body_shape(b,v).x,body_shape(b,v).y
      rotate_vector2(RBD_V1,body(b).p.w)
      px#=body(b).p.x+x vector2(RBD_V1)
      py#=body(b).p.y+y vector2(RBD_V1)
      `circle screenx(px#),screeny(py#),6
      set vector2 RBD_V1,body_shape(b,v).x,body_shape(b,v).y
      rotate_vector2(RBD_V1,body(b).p.w)
      set vector2 RBD_V6,x vector2(RBD_V1)+body(b).p.x-px#,y vector2(RBD_V1)+body(b).p.y-py#
      v2#=x vector2(RBD_V6)*nx#+y vector2(RBD_V6)*ny#
`      print "V1:",v1#
      for v2=0 to body(bother).vertex_amount-1
         set vector2 RBD_V1,body_shape(bother,v2).x,body_shape(bother,v2).y
         rotate_vector2(RBD_V1,body(bother).p.w)
         set vector2 RBD_V6,x vector2(RBD_V1)+body(bother).p.x-px#,y vector2(RBD_V1)+body(bother).p.y-py#
         `circle screenx(x vector2(RBD_V1)+body(bother).p.x),screeny(y vector2(RBD_V1)+body(bother).p.y),8
         v2#=x vector2(RBD_V6)*nx#+y vector2(RBD_V6)*ny#
     `    print v2,": v2:",v2#
         if v2#>-0.3
    `        text screenx(x vector2(RBD_V1)+body(bother).p.x),screeny(y vector2(RBD_V1)+body(bother).p.y),str$(v2)
            cx#=x vector2(RBD_V6)*tx#+y vector2(RBD_V6)*ty#
   `         print "CX:",cx#
            if cx#>0 and cx#<RBD.collision.edge_length
               x#=x#+cx#
               d#=v2#
               if d#>maxd#
                  maxd#=d#
               endif
               inc RBD.collision.point_amount
`               circle screenx(cx#*tx#+px#),screeny(cx#*ty#+py#),10+rnd(6)
            endif
         endif
      next v2
      x#=x#/RBD.collision.point_amount
      RBD.collision.distance=-maxd#
     ` print maxd#
`
      RBD.collision.pt.x=x#*tx#+px#
      RBD.collision.pt.y=x#*ty#+py#
      if b=b1
         RBD.collision.n.x=-nx#
         RBD.collision.n.y=-ny#
      else
         RBD.collision.n.x=nx#
         RBD.collision.n.y=ny#
      endif
   endif
   x=screenx(RBD.collision.pt.x),
   y=screeny(RBD.collision.pt.y)
   box x-1,y-1,x+1,y+1
 `  print "b1:",b1,",","b2:",b2
`   print "body:",RBD.collision.body,"P:",body(b).p.x,",",body(b).p.y
`   print "edge:",RBD.collision.edge," l=",RBD.collision.edge_length
`   print "distance:",RBD.collision.distance
`   print "normal:",RBD.collision.n.x,",",RBD.collision.n.y,",   ","tanget normal:",tx#,",",ty#
`   print "other body:",bother,"P:",body(bother).p.x,",",body(bother).p.y
endfunction 1

function screenx(x#)
position object dummy_obj,x#,0,0
x#=object screen x(dummy_obj)
endfunction x#
function screeny(y#)
position object dummy_obj,0,y#,0
y#=object screen y(dummy_obj)
endfunction y#


function mod(a,b)
if a<0 then a=a+b
RV = int(a / b)
RV = RV * b
RV = a - RV
endfunction RV

function RBD_GetBody(obj)
   for b=0 to max_body_amount
      if body(b).exist=1
         if body(b).object=obj
            exitfunction b
         endif
      endif
   next b
endfunction -1

function RBD_GetDBPro(body)
   obj=body(body).object
endfunction obj

function RBD_MaterialGetDefaultGroupID()
endfunction 0

function RBD_MaterialCreateGroupID()
   i=0
   while groupid(i)=1
      inc i
   endwhile
   groupid(i)=1
   for n=0 to max_material_amount
      material(i,n).collidable=1
      material(i,n).elasticity=1.0
   next n
endfunction i

function RBD_MaterialSetDefaultCollidable(mat1,mat2,state)
   material(mat1,mat2).collidable=state
endfunction

function RBD_MaterialSetDefaultFriction(mat1,mat2,sfriction#,kfriction#)
   material(mat1,mat2).sfriction=sfriction#
   material(mat1,mat2).kfriction=kfriction#
endfunction

function RBD_MaterialSetDefaultElasticity(mat1,mat2,elasticity#)
   material(mat1,mat2).elasticity=elasticity#
endfunction

function RBD_CalculateMIBoxSolid(mass#,sx#,sy#)
moi#=(1.0/12.0)*mass#*(sx#^2+sy#^2)
endfunction moi#

function RBD_CalculateMICircleSolid(mass#,r#)
moi#=1.0/2*mass#*r#^2
endfunction moi#

function RBD_BodySetMass(b,mass#,moi#)
   body(b).mass=mass#
   if moi#<>0
      body(b).moi=moi#
   endif
endfunction