Vektor Data rectangle

Started by Frank Brübach, October 24, 2023, 06:21:38 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Print
Go Down Pages1
User actions

Frank Brübach

October 24, 2023, 06:21:38 PM Last Edit: October 24, 2023, 06:49:15 PM by Charles Pegge
Hello.. need a little Help to place the Last 4th D Point in correct Order its on same place Like C Point .. Other Relations I have Managed
thanks in advance
Regards frank
Code Select
'#compact
 '%filename "t.exe"
 'uses RTL64
  % Title "Rectangle Data:  Move points with mouse and arrow keys etc"

 '% WindowStyle WS_OVERLAPPEDWINDOW
 '% Animated
 '% ScaleUp
  % PlaceCentral
  % AnchorCentral

  % shaders
  uses consoleG
 'uses glo2/geoplanar
 
  'Keys: Esc, arrow-keys, n,m, F4
'------------------------------------
  dim angle as single
  static single framecounter
'------------------------------------
  BeginScript

  procedure sqbutton(float x,y)
  =============================
  glbegin GL_QUADS
  glvertex2f 0,0
  glvertex2f x,0
  glvertex2f x,y
  glvertex2f 0,y
  glend
  end procedure

  procedure main()
  ================
  sys a,i,p
  static string ins
  static string s
  static string dat[10,10]

  if opening
    'INTIAL EXAMPLE DATA
    int x,y
    for y=1 to 4 '8
      for x=1 to 4 '8
        dat[y,x]="y"str(y)+" x"+str(x)
      next
    next
  endif

  cls .10,.10,.20
  '
  'GRID INPUTS
  ------------
  scale 1.5
  int x,y
  for y=1 to 4 '8
    for x=1 to 4 '8
      PushState
      move x*4,-y*2
      if pick
        'MARK PICKING AREA
        picklabel y*10+x
        move 0,0,-.01
        PutBoxArea 3,1
      else
        if picked=y*10+x
          'DATA EDITING
          color 0.9,.9,0.9
          a=input dat[y,x]
          lastkey=0
          lastchar=0
        else
          'DATA DISPLAY
          move 0,0,-.01
          color .3,.4,.3
          PutBoxArea 3,1
          move 0.2,0.2,.01
          color .8,.8,.6
          print dat[y,x]
        endif
      endif
      PopState
    next
  next
  scale 1/1.5
  printl str(picked)

  'WaitForEvent '0 off 1 on (default on)
  static quad t1,t2
  static float rc,gc,bc 'colors

  if opening 'FIRST CALL ONLY
    timemark t1
    'picked=100
    'mbox "helo"
    'Triangle interior color
    rc=0.8
    gc=0.0
    bc=0.8
  end if
  '
  if closing 'FINAL CALL BEFORE SHUTDOWN
    'mbox "Bye!"
    exit sub
  end if
  cls
  shading
  UserMovement mu,1100,4 'symbol identity, count
  if opening
    mu[1].x= 0
    mu[1].y= 5
    mu[2].x=-5
    mu[2].y=-5
    mu[3].x= 5
    mu[3].y=-5
    mu[4].x= 5
    mu[4].y=-5
  endif
  scale 1
  picklabel 0
  int i
  for i=1 to 4 '3
    pushstate
    color 1,.9,0,1
    mu[i].act
    scale 0.5
    go sphere
    popstate
  next
  picklabel 0
  'float xa,xb,xc,ya,yb,yc
  float xa,xb,xc,xd,ya,yb,yc,yd
  xa=mu[1].x : ya=mu[1].y 'triangle
  xb=mu[2].x : yb=mu[2].y
  xc=mu[3].x : yc=mu[3].y
  xd=mu[4].x : yd=mu[4].y 'rectangle
  '
  select picked
    'COLOR BUTTON SELECTION
    case 10 : rc=0.9 : gc=0.2 : bc=0.0
    case 20 : rc=0.2 : gc=0.9 : bc=0.0
    case 30 : rc=0.0 : gc=0.6 : bc=0.9
    case 40 : rc=0.6 : gc=0.0 : bc=0.9
    case 50 : rc=0.2 : gc=0.9 : bc=0.9
    '.20,.90,.90
    'MOUSE DRAG ADJUSTMENT
    case 1100 : xa+=mu[1].d.x : ya+=mu[1].d.y
    case 1200 : xb+=mu[2].d.x : yb+=mu[2].d.y
    case 1300 : xc+=mu[3].d.x : yc+=mu[3].d.y
    case 1400 : xd+=mu[4].d.x : yd+=mu[4].d.y

  end select
  flat
  thickness 2
  '
  if pick
    picklabel 2000
  else
    color 1,1,0,1
    pushstate
    move xa-.5,ya-1
    gprint "A"
    popstate
    pushstate
    move xb+1,yb+1
    gprint "B"
    popstate
    pushstate
    move xc-1,yc+1
    gprint "C"
    popstate
    pushstate 'üroblem?
    move xd-1,yd+1
    gprint "D"
    popstate
  endif
  '
  if not pick
    color rc,gc,bc
    float zp=-1.001
    ''glBegin GL_TRIANGLES
    glbegin GL_QUADS
    glVertex3f xa,ya,zp
    glVertex3f xb,yb,zp
    glVertex3f xc,yc,zp
    glVertex3f xd,yd,zp 'rect
    glEnd
    '
    color 0,.9,.9
    glBegin GL_LINES
    glVertex2f xa,ya
    glVertex2f xb,yb
    glVertex2f xb,yb
    glVertex2f xc,yc
    glVertex2f xc,yc
    glVertex2f xa,ya
    glVertex2f xa,ya 'rect
    glVertex2f xd,yd 'rect
    glVertex2f xd,yd 'rect
    glVertex2f xc,yc 'rect


    glEnd
  endif
'---------------------------
    'simple rectangle
    ''glbegin GL_QUADS         
    ''  glVertex3f -4.0,  4.0, 0.0
     '' glVertex3f  4.0,  4.0, 0.0
     '' glVertex3f  4.0, -4.0, 0.0
      ''glVertex3f -4.0, -4.0, 0.0
    ''glEnd
'---------------------------
  move 5

  'if not pick
    if key[49] then picked=100 'keypress '1'
    if key[50] then picked=200 'keypress  '2'
    pushstate
    move -20,12
    static sys tally
    timemark t2
    scale 1.0
    '
    int dp=3
    '
    macro pr1(a) 'PRINTING LIST
    -----------------------------
      pushstate : color .5,1,1 : print a : popstate
      printl " "
    end macro
    '
    macro pr2(a,b) 'PRINTING LIST
    -----------------------------
      pushstate : color .5,1,1 : print a : popstate
      pushstate : color 1,1,.5 : move 4 : print str(b,dp) : popstate
      printl " "
    end macro
    '
    macro pr3(a,b,c) 'PRINTING LIST
    ------------------------------
      pushstate : color .5,1,1 : print a : popstate
      pushstate : color 1,1,.5 : move 4 : print str(b,dp) : popstate
      pushstate : color 1,1,.5 : move 8 : print str(c,dp) : popstate
      printl " "
    end macro
    '
    'BUTTON CONTROLS
    ----------------
    '
    pushstate
    if pick
      picklabel 10
    else
      color .80,.2,0
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 20
    else
      color .2,.80,0
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 30
    else
      color 0,.60,.90
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 40
    else
      color .60,0,.90
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 50
    else
      color .20,.90,.90
    endif
    sqbutton 2,2
    move 3.0
   
'-----------------------------

    popstate

    move 0,-3.0,0
    '
    'DISPLAY INFO
    -------------
    picklabel 0

    pushstate
    scale 2
    'color 1,1,1
    color 1,1,1
    print "Rectangle Data" ''"Triangle Data"
    popstate

    move 0,-1.5

   'pr2 "Action Code:   ", act
   'pr2 "indexbase      ", indexbase
   'pr2 "Keyboard Code: ", keyd
    pr2 "Picked ID:     ", picked
    '
    move 0,-1.5
    '
    pr3 "Point A: ", str(xa,3), ya
    pr3 "Point B: ", str(xb,3), yb
    pr3 "Point C: ", str(xc,3), yc
    pr3 "Point D: ", str(xd,3), yd
    '
    float ab,ac,ad,dc,bc,ar,ht,hb
    '
    ab=hypot(xa-xb, ya-yb)
    ac=hypot(xa-xc, ya-yc)
    bc=hypot(xb-xc, yb-yc)
    ad=hypot(xa-xd, ya-yd)
    dc=hypot(xd-xc, yd-yc)
    '
    hb=0.5* ( ab*ab - ac*ac + bc*bc ) / bc
    ht=sqr(ab*ab-hb*hb)
    ar=0.5*bc*ht

    'ANGLES
    float na,nb,nc,nd
    nb=deg(asin(ht/ab))
    nc=deg(asin(ht/ac))
    na=180-nb-nc

    pr1 " "
    pr2 "Angle A:",na
    pr2 "Angle B:",nb
    pr2 "Angle C:",nc
    pr2 "Angle D:",nd
   
    pr1 ""
    pr2 "Line AB:",ab
    pr2 "Line AC:",ac
    pr2 "Line BC:",bc
    pr2 "Line AD:",ad 'rectangle
    pr2 "Line DC:",dc
    pr2 "Left base:",hb
    pr2 "Height:",ht
    pr2 "Area:", ar
    pr1 ""
    '
    picklabel 0
    popstate
  'end if
  'drawPyramid()
  end procedure 'main
 
  EndScript

Charles Pegge

#1
October 24, 2023, 10:55:51 PM
Hi Frank,

I had to make quite a few changes. Where are we going with this? Perhaps creating  and designing polygons? This is just a quick fix:

Code Select
#compact
 '%filename "t.exe"
 'uses RTL64
  % Title "Rectangle Data:  Move points with mouse and arrow keys etc"

 '% WindowStyle WS_OVERLAPPEDWINDOW
 '% Animated
 '% ScaleUp
  % PlaceCentral
  % AnchorCentral

  % shaders
  uses consoleG
 'uses glo2/geoplanar
 
  'Keys: Esc, arrow-keys, n,m, F4
'------------------------------------
  dim angle as single
  static single framecounter
'------------------------------------
  BeginScript

  procedure sqbutton(float x,y)
  =============================
  glbegin GL_QUADS
  glvertex2f 0,0
  glvertex2f x,0
  glvertex2f x,y
  glvertex2f 0,y
  glend
  end procedure

  procedure main()
  ================
  sys a,i,p
  static string ins
  static string s
  static string dat[10,10]

  if opening
    'INTIAL EXAMPLE DATA
    int x,y
    for y=1 to 4 '8
      for x=1 to 4 '8
        dat[y,x]="y"str(y)+" x"+str(x)
      next
    next
  endif

  cls .10,.10,.20
  '
  'GRID INPUTS
  ------------
  scale 1.5
  int x,y
  for y=1 to 4 '8
    for x=1 to 4 '8
      PushState
      move x*4,-y*2
      if pick
        'MARK PICKING AREA
        picklabel y*10+x
        move 0,0,-.01
        PutBoxArea 3,1
      else
        if picked=y*10+x
          'DATA EDITING
          color 0.9,.9,0.9
          a=input dat[y,x]
          lastkey=0
          lastchar=0
        else
          'DATA DISPLAY
          move 0,0,-.01
          color .3,.4,.3
          PutBoxArea 3,1
          move 0.2,0.2,.01
          color .8,.8,.6
          print dat[y,x]
        endif
      endif
      PopState
    next
  next
  scale 1/1.5
  'printl str(picked)

  'WaitForEvent '0 off 1 on (default on)
  static quad t1,t2
  static float rc,gc,bc 'colors

  if opening 'FIRST CALL ONLY
    timemark t1
    'picked=100
    'mbox "helo"
    'Triangle interior color
    rc=0.8
    gc=0.0
    bc=0.8
  end if
  '
  if closing 'FINAL CALL BEFORE SHUTDOWN
    'mbox "Bye!"
    exit sub
  end if
  cls
  shading
  UserMovement mu,1100,4 'symbol identity, count
  if opening
    mu[1].x= 0
    mu[1].y= 5
    mu[2].x=-5
    mu[2].y=-5
    mu[3].x= 5
    mu[3].y=-5
    mu[4].x= 0
    mu[4].y=-10
  endif
  scale 1
  picklabel 0
  int i
  for i=1 to 4 '3
    pushstate
    color 1,.9,0,1
    mu[i].act
    scale 0.5
    go sphere
    popstate
  next
  picklabel 0
  'float xa,xb,xc,ya,yb,yc
  float xa,xb,xc,xd,ya,yb,yc,yd
  xa=mu[1].x : ya=mu[1].y 'triangle
  xb=mu[2].x : yb=mu[2].y
  xc=mu[3].x : yc=mu[3].y
  xd=mu[4].x : yd=mu[4].y 'rectangle
  '
  select picked
    'COLOR BUTTON SELECTION
    case 10 : rc=0.9 : gc=0.2 : bc=0.0
    case 20 : rc=0.2 : gc=0.9 : bc=0.0
    case 30 : rc=0.0 : gc=0.6 : bc=0.9
    case 40 : rc=0.6 : gc=0.0 : bc=0.9
    case 50 : rc=0.2 : gc=0.9 : bc=0.9
    '.20,.90,.90
    'MOUSE DRAG ADJUSTMENT
    case 1100 : xa+=mu[1].d.x : ya+=mu[1].d.y
    case 1200 : xb+=mu[2].d.x : yb+=mu[2].d.y
    case 1300 : xc+=mu[3].d.x : yc+=mu[3].d.y
    case 1400 : xd+=mu[4].d.x : yd+=mu[4].d.y

  end select
  flat
  thickness 2
  '
  if pick
    picklabel 2000
  else
    color 1,1,0,1
    pushstate
    move xa-.5,ya-1
    gprint "A"
    popstate
    pushstate
    move xb+1,yb+1
    gprint "B"
    popstate
    pushstate
    move xc-1,yc+1
    gprint "C"
    popstate
    pushstate 'üroblem?
    move xd-1,yd+1
    gprint "D"
    popstate
  endif
  '
  if not pick
    pushstate
    color rc,gc,bc
    float zp=-1.001
    move 0,0,zp
    ''glBegin GL_TRIANGLES
    glbegin GL_QUADS
    glVertex2f xa,ya
    glVertex2f xb,yb
    glVertex2f xd,yd
    glVertex2f xc,yc'rect
    glEnd
    popstate
    '
    pushstate
    color 0,.9,.9
    glBegin GL_LINES
    glVertex2f xa,ya
    glVertex2f xb,yb
    '
    glVertex2f xb,yb
    glVertex2f xd,yd
    '
    glVertex2f xd,yd
    glVertex2f xc,yc
    '
    glVertex2f xc,yc
    glVertex2f xa,ya
    glEnd
    popstate
  endif
'---------------------------
    'simple rectangle
    ''glbegin GL_QUADS         
    ''  glVertex3f -4.0,  4.0, 0.0
     '' glVertex3f  4.0,  4.0, 0.0
     '' glVertex3f  4.0, -4.0, 0.0
      ''glVertex3f -4.0, -4.0, 0.0
    ''glEnd
'---------------------------
  move 5

  'if not pick
    if key[49] then picked=100 'keypress '1'
    if key[50] then picked=200 'keypress  '2'
    pushstate
    move -20,12
    static sys tally
    timemark t2
    scale 1.0
    '
    int dp=3
    '
    macro pr1(a) 'PRINTING LIST
    -----------------------------
      pushstate : color .5,1,1 : print a : popstate
      printl " "
    end macro
    '
    macro pr2(a,b) 'PRINTING LIST
    -----------------------------
      pushstate : color .5,1,1 : print a : popstate
      pushstate : color 1,1,.5 : move 4 : print str(b,dp) : popstate
      printl " "
    end macro
    '
    macro pr3(a,b,c) 'PRINTING LIST
    ------------------------------
      pushstate : color .5,1,1 : print a : popstate
      pushstate : color 1,1,.5 : move 4 : print str(b,dp) : popstate
      pushstate : color 1,1,.5 : move 8 : print str(c,dp) : popstate
      printl " "
    end macro
    '
    'BUTTON CONTROLS
    ----------------
    '
    pushstate
    if pick
      picklabel 10
    else
      color .80,.2,0
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 20
    else
      color .2,.80,0
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 30
    else
      color 0,.60,.90
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 40
    else
      color .60,0,.90
    endif
    sqbutton 2,2
    move 3.0
    '
    if pick
      picklabel 50
    else
      color .20,.90,.90
    endif
    sqbutton 2,2
    move 3.0
   
'-----------------------------

    popstate

    move 0,-3.0,0
    '
    'DISPLAY INFO
    -------------
    picklabel 0

    pushstate
    scale 2
    'color 1,1,1
    color 1,1,1
    print "Rectangle Data" ''"Triangle Data"
    popstate

    move 0,-1.5

   'pr2 "Action Code:   ", act
   'pr2 "indexbase      ", indexbase
   'pr2 "Keyboard Code: ", keyd
    pr2 "Picked ID:     ", picked
    '
    move 0,-1.5
    '
    pr3 "Point A: ", str(xa,3), ya
    pr3 "Point B: ", str(xb,3), yb
    pr3 "Point C: ", str(xc,3), yc
    pr3 "Point D: ", str(xd,3), yd
    '
    float ab,ac,ad,dc,bc,ar,ht,hb
    '
    ab=hypot(xa-xb, ya-yb)
    ac=hypot(xa-xc, ya-yc)
    bc=hypot(xb-xc, yb-yc)
    ad=hypot(xa-xd, ya-yd)
    dc=hypot(xd-xc, yd-yc)
    '
    hb=0.5* ( ab*ab - ac*ac + bc*bc ) / bc
    ht=sqr(ab*ab-hb*hb)
    ar=0.5*bc*ht
   

    'ANGLES
    float na,nb,nc,nd
    nb=deg(asin(ht/ab))
    nc=deg(asin(ht/ac))
    na=180-nb-nc

    pr1 " "
    pr2 "Angle A:",na
    pr2 "Angle B:",nb
    pr2 "Angle C:",nc
    pr2 "Angle D:",nd
   
    pr1 ""
    pr2 "Line AB:",ab
    pr2 "Line AC:",ac
    pr2 "Line BC:",bc
    pr2 "Line AD:",ad 'rectangle
    pr2 "Line DC:",dc
    pr2 "Left base:",hb
    pr2 "Height:",ht
    pr2 "Area:", ar
    pr1 ""
    '
    picklabel 0
    popstate
  'end if
  'drawPyramid()
  end procedure 'main
 
  EndScript

PS I've put 'code' /code' markups around your source code. Makes it easier to read.

Frank Brübach

#2
October 25, 2023, 08:26:49 AM
Many thanks Charles works fine Here I fixed a vector Code for D Angle in my First example too :)
Nice wednesday Back
Print
Go Up Pages1
User actions