home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 451-475 / apd463 / amos1.34_progs / structured_drawing.amos / structured_drawing.amosSourceCode
AMOS Source Code  |  1993-01-17  |  13KB  |  626 lines
  1. ' Structured Drawing 
  2. '
  3. '  AMOS Basic 1992   
  4. '
  5. ' ================== 
  6. '
  7. ' This program needs a lot of work done on it
  8. ' you will have to work this one out for yourself! 
  9. '
  10. Set Buffer 20
  11. '
  12. Degree 
  13. Dim X(1000),Y(1000),GRIDX(500),GRIDY(500)
  14. '
  15. Global X(),Y(),GRIDX(),GRIDY(),NP,SNAP,GDN,PN,SXY,LE,SW
  16. Global AJ,OP
  17. LE=1
  18. '
  19. Close Editor 
  20. '
  21. Screen Open 0,640,512,8,Hires+Laced
  22. Screen Display 0,,48,,
  23. Flash Off : Curs Off : Cls 
  24. Palette $0,$888,,$999
  25. Change Mouse 2
  26. Ink 0
  27. '
  28. INITMENU
  29. GRID1
  30. '
  31. Do 
  32.    '
  33.    Limit Mouse 
  34.    '
  35.    If Key State(69) Then QUIT
  36.    If Key State(89) Then REDRAW
  37.    If Mouse Key=1 and LE=1 Then LINEDRAW
  38.    If Mouse Key=1 and LE=2 Then ARC
  39.    If Mouse Key=1 and LE=3 Then CIRCL
  40.    '
  41.    SXY
  42.    '
  43. Loop 
  44. '
  45. Procedure INITMENU
  46.    Menu$(1)=" Project "
  47.    Menu$(1,1)="---------"
  48.    Menu$(1,2)=" New     "
  49.    Menu$(1,3)="---------"
  50.    Menu$(1,4)=" Load    "
  51.    Menu$(1,5)="---------"
  52.    Menu$(1,6)=" Save    "
  53.    Menu$(1,7)=" Save As "
  54.    Menu$(1,8)="---------"
  55.    Menu$(1,9)=" About   "
  56.    Menu$(1,10)="---------"
  57.    Menu$(1,11)=" Quit    "
  58.    Menu$(1,12)="---------"
  59.    '
  60.    Menu$(2)=" Grid "
  61.    Menu$(2,1)="-----------"
  62.    Menu$(2,2)=" Off       "
  63.    Menu$(2,3)=" Fine      "
  64.    Menu$(2,4)=" Coarse    "
  65.    Menu$(2,5)=" Isometric "
  66.    Menu$(2,6)="-----------"
  67.    Menu$(2,7)=" Snap "
  68.    Menu$(2,7,1)="-----------------"
  69.    Menu$(2,7,2)=" No Snap         "
  70.    Menu$(2,7,3)="-----------------"
  71.    Menu$(2,7,4)=" Snap To Grid    "
  72.    Menu$(2,7,5)="-----------------"
  73.    Menu$(2,7,6)=" Snap To Drawing "
  74.    Menu$(2,7,7)="-----------------"
  75.    '
  76.    Menu$(3)=" Options "
  77.    Menu$(3,1)="---------"
  78.    Menu$(3,2)=" Show XY "
  79.    Menu$(3,2,1)=" Yes "
  80.    Menu$(3,2,2)="-----"
  81.    Menu$(3,2,3)=" No  "
  82.    '
  83.    Menu$(4)=" Draw "
  84.    Menu$(4,1)="--------"
  85.    Menu$(4,2)=" Line   "
  86.    Menu$(4,3)=" Arc    "
  87.    Menu$(4,4)=" Circle "
  88.    '
  89.    Menu$(5)=" Edit "
  90.    Menu$(5,1)="--------------"
  91.    Menu$(5,2)=" Edit Point   "
  92.    Menu$(5,3)=" Insert Point "
  93.    Menu$(5,4)=" Delete Point "
  94.    '
  95.    On Menu Proc MNU1,MNU2,MNU3,MNU4,MNU5
  96.    Menu On 
  97.    On Menu On 
  98. End Proc
  99. Procedure REDRAW
  100.    Cls 
  101.    If GDN=1 Then GRID1
  102.    If GDN=2 Then GRID2
  103.    If GDN=3 Then GRID3
  104.    Ink 0
  105.    For N=0 To NP Step 2
  106.       If X(N)+Y(N)>0 and X(N+1)+Y(N+1)>0
  107.          Draw X(N),Y(N) To X(N+1),Y(N+1)
  108.       End If 
  109.    Next N
  110. End Proc
  111. Procedure GRID1
  112.    Ink 3
  113.    For A=0 To 640 Step 60
  114.       Draw A,0 To A,512
  115.    Next A
  116.    For B=0 To 512 Step 60
  117.       Draw 0,B To 640,B
  118.    Next B
  119.    Ink 0
  120.    If DRW=1 Then REDRAW
  121.    GRIDCOORDS[60]
  122.    GDN=1
  123. End Proc
  124. Procedure GRID2
  125.    Ink 3
  126.    For A=0 To 640 Step 30
  127.       Draw A,0 To A,512
  128.    Next A
  129.    For B=0 To 512 Step 30
  130.       Draw 0,B To 640,B
  131.    Next B
  132.    Ink 0
  133.    GRIDCOORDS[30]
  134.    GDN=2
  135. End Proc
  136. Procedure GRID3
  137.    Ink 3
  138.    O=Tan(30)*640
  139.    For A=0 To 870 Step 30
  140.       Draw 640,A To 0,A-O
  141.    Next A
  142.    For B=0 To 870 Step 30
  143.       Draw 0,B To 640,B-O
  144.    Next B
  145.    For N=8 To 640 Step 26
  146.       Draw N,0 To N,512
  147.    Next N
  148.    Ink 0
  149.    ISOGRID
  150.    GDN=3
  151. End Proc
  152. Procedure GRIDCOORDS[SP]
  153.    PN=0
  154.    For B=0 To 512 Step SP
  155.       For A=0 To 640 Step SP
  156.          GRIDX(PN)=A : GRIDY(PN)=B
  157.          Inc PN
  158.       Next A
  159.    Next B
  160. End Proc
  161. Procedure ISOGRID
  162.    For B=10 To 512 Step 30
  163.       For A=34 To 640 Step 52
  164.          GRIDX(U)=A : GRIDY(U)=B
  165.          Inc U
  166.       Next A
  167.    Next B
  168.    For B=25 To 512 Step 30
  169.       For A=8 To 640 Step 52
  170.          GRIDX(U)=A : GRIDY(U)=B
  171.          Inc U
  172.       Next A
  173.    Next B
  174. End Proc
  175. Procedure MNU1
  176.    T=Choice(2)
  177.    If T=2 Then _NEW
  178.    If T=9 Then ABOUT
  179.    If T=11 Then QUIT
  180.    On Menu On 
  181. End Proc
  182. Procedure MNU2
  183.    I=Choice(2)
  184.    If I=2
  185.       GDN=0
  186.       REDRAW
  187.    End If 
  188.    If I=3
  189.       GDN=2
  190.       REDRAW
  191.    End If 
  192.    If I=4
  193.       GDN=1
  194.       REDRAW
  195.    End If 
  196.    If I=5
  197.       GDN=3
  198.       REDRAW
  199.    End If 
  200.    T=Choice(3)
  201.    If T=2 Then SNAP=0
  202.    If T=4 Then SNAP=1
  203.    If T=6 Then SNAP=2
  204.    On Menu On 
  205. End Proc
  206. Procedure MNU3
  207.    T=Choice(3)
  208.    If T=1 Then SXY=1
  209.    If T=3
  210.       SXY=0
  211.       REDRAW
  212.    End If 
  213.    On Menu On 
  214. End Proc
  215. Procedure MNU4
  216.    T=Choice(2)
  217.    If T=2 Then LE=1
  218.    If T=3 Then LE=2
  219.    If T=4 Then LE=3
  220. End Proc
  221. Procedure MNU5
  222.    I=Choice(2)
  223.    If I=2 Then EDPNT
  224.    If I=3 Then ADPNT
  225.    If I=4 Then DTPNT
  226. End Proc
  227. Procedure SNAP1[DP]
  228.    If SW=1 Then Goto PT2
  229.    For A=0 To PN
  230.       If Abs(GRIDX(A)-X(DP))<5 and Abs(GRIDY(A)-Y(DP))<5
  231.          X(DP)=GRIDX(A) : Y(DP)=GRIDY(A)
  232.          Exit 
  233.       End If 
  234.    Next A
  235.    PT2:
  236.    If SW=0 Then Goto PT3
  237.    For A=0 To PN
  238.       If Abs(GRIDX(A)-X(DP+1))<5 and Abs(GRIDY(A)-Y(DP+1))<5
  239.          X(DP+1)=GRIDX(A) : Y(DP+1)=GRIDY(A)
  240.          Exit 
  241.       End If 
  242.    Next A
  243.    PT3:
  244. End Proc
  245. Procedure SNAP2[DP]
  246.    If SW=1 Then Goto PT2
  247.    For A=0 To PN
  248.       If Abs(X(A)-X(DP))<5 and Abs(Y(A)-Y(DP))<5
  249.          X(DP)=X(A) : Y(DP)=Y(A)
  250.          Exit 
  251.       End If 
  252.    Next A
  253.    PT2:
  254.    If SW=0 Then Goto PT3
  255.    For A=0 To PN
  256.       If Abs(X(A)-X(DP+1))<5 and Abs(Y(A)-Y(DP+1))<5
  257.          X(DP+1)=X(A) : Y(DP+1)=Y(A)
  258.          Exit 
  259.       End If 
  260.    Next A
  261.    PT3:
  262. End Proc
  263. Procedure SXY
  264.    If SXY=0 Then Pop Proc
  265.    L=Sqr((AJ*AJ)+(OP*OP))
  266.    Locate 2,62 : Print Using "X:###";X Screen(X Mouse)
  267.    Locate 12,62 : Print Using "Y:###";Y Screen(Y Mouse)
  268.    Locate 20,62 : Print Using "L/R:###";L
  269. End Proc
  270. Procedure CIRCL
  271.    Menu Off 
  272.    Repeat 
  273.       SXY
  274.       CX1=X Screen(X Mouse) : CY1=Y Screen(Y Mouse)
  275.    Until Mouse Key=0
  276.    If SNAP=1
  277.       For A=0 To PN
  278.          If Abs(GRIDX(A)-CX1)<5 and Abs(GRIDY(A)-CY1)<5
  279.             CX1=GRIDX(A) : CY1=GRIDY(A)
  280.             Exit 
  281.          End If 
  282.       Next A
  283.    End If 
  284.    If SNAP=2
  285.       For A=0 To PN
  286.          If Abs(X(A)-CX1)<5 and Abs(Y(A)-CY1)<5
  287.             CX1=X(A) : CY1=Y(A)
  288.             Exit 
  289.          End If 
  290.       Next A
  291.    End If 
  292.    Gr Writing 3
  293.    Repeat 
  294.       SXY
  295.       CX2=X Screen(X Mouse) : CY2=Y Screen(Y Mouse)
  296.       Draw CX1,CY1 To CX2,CY2
  297.       Wait 2
  298.       Draw CX1,CY1 To CX2,CY2
  299.       AJ=CX2-CX1 : OP=CY2-CY1
  300.    Until Mouse Key=2
  301.    Gr Writing 1
  302.    If SNAP=1
  303.       For A=0 To PN
  304.          If Abs(GRIDX(A)-CX2)<5 and Abs(GRIDY(A)-CY2)<5
  305.             CX2=GRIDX(A) : CY2=GRIDY(A)
  306.             Exit 
  307.          End If 
  308.       Next A
  309.    End If 
  310.    If SNAP=2
  311.       For A=0 To PN
  312.          If Abs(X(A)-CX2)<5 and Abs(Y(A)-CY2)<5
  313.             CX2=X(A) : CY2=Y(A)
  314.             Exit 
  315.          End If 
  316.       Next A
  317.    End If 
  318.    AJ=0 : OP=0
  319.    Repeat 
  320.    Until Mouse Key=0
  321.    A=Abs(CX1-CX2) : O=Abs(CY1-CY2)
  322.    R=Sqr((A*A)+(O*O))
  323.    DRWCURVE[CX1,CY1,0,360,R]
  324.    Menu On 
  325.    On Menu On 
  326. End Proc
  327. Procedure ARC
  328.    Menu Off 
  329.    Repeat 
  330.       SXY
  331.       CX1=X Screen(X Mouse) : CY1=Y Screen(Y Mouse)
  332.    Until Mouse Key=0
  333.    If SNAP=1
  334.       For A=0 To PN
  335.          If Abs(GRIDX(A)-CX1)<5 and Abs(GRIDY(A)-CY1)<5
  336.             CX1=GRIDX(A) : CY1=GRIDY(A)
  337.             Exit 
  338.          End If 
  339.       Next A
  340.    End If 
  341.    If SNAP=2
  342.       For A=0 To PN
  343.          If Abs(X(A)-CX1)<5 and Abs(Y(A)-CY1)<5
  344.             CX1=X(A) : CY1=Y(A)
  345.             Exit 
  346.          End If 
  347.       Next A
  348.    End If 
  349.    Gr Writing 3
  350.    Repeat 
  351.       SXY
  352.       AX1=X Screen(X Mouse) : AY1=Y Screen(Y Mouse)
  353.       Draw CX1,CY1 To AX1,AY1
  354.       Wait 2
  355.       Draw CX1,CY1 To AX1,AY1
  356.    Until Mouse Key=2
  357.    If SNAP=1
  358.       For A=0 To PN
  359.          If Abs(GRIDX(A)-AX1)<5 and Abs(GRIDY(A)-AY1)<5
  360.             AX1=GRIDX(A) : AY1=GRIDY(A)
  361.             Exit 
  362.          End If 
  363.       Next A
  364.    End If 
  365.    If SNAP=2
  366.       For A=0 To PN
  367.          If Abs(X(A)-AX1)<5 and Abs(Y(A)-AY1)<5
  368.             AX1=X(A) : AY1=Y(A)
  369.             Exit 
  370.          End If 
  371.       Next A
  372.    End If 
  373.    Draw CX1,CY1 To AX1,AY1
  374.    Wait 10
  375.    Repeat 
  376.       SXY
  377.       AX2=X Screen(X Mouse) : AY2=Y Screen(Y Mouse)
  378.       Draw CX1,CY1 To AX2,AY2
  379.       Wait 2
  380.       Draw CX1,CY1 To AX2,AY2
  381.    Until Mouse Key=2
  382.    Draw CX1,CY1 To AX1,AY1
  383.    Gr Writing 1
  384.    If SNAP=1
  385.       For A=0 To PN
  386.          If Abs(GRIDX(A)-AX1)<5 and Abs(GRIDY(A)-AY1)<5
  387.             AX1=GRIDX(A) : AY1=GRIDY(A)
  388.             Exit 
  389.          End If 
  390.       Next A
  391.    End If 
  392.    If SNAP=2
  393.       For A=0 To PN
  394.          If Abs(X(A)-AX1)<5 and Abs(Y(A)-AY1)<5
  395.             AX1=X(A) : AY1=Y(A)
  396.             Exit 
  397.          End If 
  398.       Next A
  399.    End If 
  400.    Repeat 
  401.    Until Mouse Key=0
  402.    '
  403.    R#=Sqr(Abs(((AX1-CX1)*(AX1-CX1))+((AY1-CY1)*(AY1-CY1))))
  404.    '
  405.    TS#=Acos(Abs((AX1-CX1)/R#))
  406.    TE#=Acos(Abs((AX2-CX1)/R#))
  407.    '
  408.    TS=TS# : TE=TE# : R=R#
  409.    '
  410.    If AX1=CX1 and AX2=CX1 and AY1<CY1
  411.       TS=TS-90 : TE=TE+90
  412.       Goto P3
  413.    End If 
  414.    '
  415.    If AX1=CX1 and AX2=CX1 and AY1>CY1
  416.       TS=TS+90 : TE=TE+270
  417.       Goto P3
  418.    End If 
  419.    '
  420.    If AY1=CY1 and AY2=CY1 and AX1<CX1
  421.       TS=TS+270 : TE=TE+450
  422.       Goto P3
  423.    End If 
  424.    '
  425.    If AY1=CY1 and AY2=CY1 and AX1>CX1
  426.       TS=TS+270 : TE=TE+90
  427.       Goto P3
  428.    End If 
  429.    '
  430.    If AY1=CY1 and AY2>CY1
  431.       TS=TS+180
  432.       Goto P2
  433.    End If 
  434.    '
  435.    If AX1=CX1 and AX2<CX1
  436.       TS=TS+180
  437.       TE=TE+180
  438.       Goto P3
  439.    End If 
  440.    '
  441.    If AY1=CY1 and AY2<CY1
  442.       TS=TS+270
  443.       TE=TE+270
  444.       Goto P3
  445.    End If 
  446.    '
  447.    If AX1>CX1 and AY1>CY1 Then TS=TS+90
  448.    If AX1<CX1 and AY1>CY1 Then TS=TS+180
  449.    If AX1<CX1 and AY1<CY1 Then TS=TS+270
  450.    '
  451.    P2:
  452.    '
  453.    If AX2>CX1 and AY2>CY1 Then TE=TE+90
  454.    If AX2<CX1 and AY2>CY1 Then TE=TE+180
  455.    If AX2<CX1 and AY2<CY1 Then TE=TE+270
  456.    '
  457.    P3:
  458.    '
  459.    If TS>TE Then Swap TS,TE
  460.    '
  461.    DRWCURVE[CX1,CY1,TS,TE,R]
  462.    Menu On 
  463.    On Menu On 
  464. End Proc
  465. Procedure LINEDRAW
  466.    Menu Off 
  467.    Repeat 
  468.       SXY
  469.       X(NP)=X Screen(X Mouse) : Y(NP)=Y Screen(Y Mouse)
  470.    Until Mouse Key=0
  471.    If SNAP=1
  472.       SNAP1[NP]
  473.    End If 
  474.    If SNAP=2
  475.       SNAP2[NP]
  476.    End If 
  477.    SW=1
  478.    Gr Writing 3
  479.    Repeat 
  480.       SXY
  481.       X(NP+1)=X Screen(X Mouse) : Y(NP+1)=Y Screen(Y Mouse)
  482.       Draw X(NP),Y(NP) To X(NP+1),Y(NP+1)
  483.       Wait 2
  484.       Draw X(NP),Y(NP) To X(NP+1),Y(NP+1)
  485.       AJ=X(NP+1)-X(NP) : OP=Y(NP+1)-Y(NP)
  486.    Until Mouse Key=2
  487.    Gr Writing 1
  488.    SW=1
  489.    If SNAP=1
  490.       SNAP1[NP]
  491.    End If 
  492.    If SNAP=2
  493.       SNAP2[NP]
  494.    End If 
  495.    Draw X(NP),Y(NP) To X(NP+1),Y(NP+1)
  496.    Add NP,2
  497.    SW=0 : AJ=0 : OP=0
  498.    Repeat 
  499.    Until Mouse Key=0
  500.    Menu On 
  501.    On Menu On 
  502. End Proc
  503. Procedure DRWCURVE[X,Y,S,E,R]
  504.    X(NP)=X+Sin(180-S)*R : Y(NP)=Y+Cos(180-S)*R
  505.    Inc NP
  506.    OLDNP=NP
  507.    For N=S To E Step 10
  508.       X(NP)=X+Sin(180-N)*R : Y(NP)=Y+Cos(180-N)*R
  509.       Add NP,2
  510.    Next N
  511.    NP=OLDNP
  512.    For N=S To E Step 10
  513.       X(NP+1)=X+Sin(180-N)*R : Y(NP+1)=Y+Cos(180-N)*R
  514.       Add NP,2
  515.    Next N
  516.    Dec NP
  517.    REDRAW
  518. End Proc
  519. Procedure EDPNT
  520.    Menu Off 
  521.    For N=0 To NP
  522.       Plot X(N),Y(N),5
  523.    Next N
  524.    Do 
  525.       Repeat 
  526.          If Key State(69) Then Goto OUT2
  527.          SXY
  528.          EX=X Screen(X Mouse) : EY=Y Screen(Y Mouse)
  529.       Until Mouse Key=1
  530.       For N=0 To NP
  531.          If Abs(X(N)-EX)<5 and Abs(Y(N)-EY)<5
  532.             PFND=1
  533.             OLDX=X(N) : OLDY=Y(N)
  534.             Exit 
  535.          End If 
  536.       Next N
  537.       If PFND=1
  538.          If PFND=1
  539.             If N mod 2=0
  540.                WW=1
  541.             Else 
  542.                WW=-1
  543.             End If 
  544.             Ink 1
  545.             Draw X(N+WW),Y(N+WW) To X(N),Y(N)
  546.             Ink 0
  547.             Gr Writing 3
  548.          End If 
  549.          Wait 10
  550.          Repeat 
  551.             If Key State(70)
  552.                X(N)=0 : Y(N)=0
  553.                Gr Writing 1
  554.                Goto OUT
  555.             End If 
  556.             If Key State(95)
  557.                Gr Writing 1
  558.                X(N)=OLDX : Y(N)=OLDY
  559.                Draw X(N-1),Y(N-1) To X(N),Y(N)
  560.                Plot X(N-1),Y(N-1),5 : Plot X(N),Y(N),5
  561.                Goto OUT
  562.             End If 
  563.             SXY
  564.             X(N)=X Screen(X Mouse) : Y(N)=Y Screen(Y Mouse)
  565.             Draw X(N+WW),Y(N+WW) To X(N),Y(N)
  566.             Wait 2
  567.             Draw X(N+WW),Y(N+WW) To X(N),Y(N)
  568.             AJ=X(N)-X(N+WW) : OP=Y(N)-Y(N+WW)
  569.          Until Mouse Key=2
  570.          Gr Writing 1
  571.          If SNAP=1
  572.             SNAP1[N]
  573.          End If 
  574.          If SNAP=2
  575.             SNAP2[N]
  576.          End If 
  577.          Draw X(N+WW),Y(N+WW) To X(N),Y(N)
  578.          PFND=0
  579.       End If 
  580.       OUT:
  581.    Loop 
  582.    OUT2:
  583.    REDRAW
  584.    Wait 10
  585.    Menu On 
  586.    On Menu On 
  587. End Proc
  588. Procedure ADPNT
  589.    For N=0 To NP
  590.       Plot X(N),Y(N),5
  591.    Next N
  592.    Add NP,2
  593.    Repeat 
  594.    Until Mouse Key=1
  595.    X(NP)=X Screen(X Mouse) : Y(NP)=Y Screen(Y Mouse)
  596.    Plot X(NP),Y(NP),5
  597.    REDRAW
  598.    On Menu On 
  599. End Proc
  600. Procedure DTPNT
  601. End Proc
  602. Procedure ABOUT
  603.    Menu Off 
  604.    Cls 0,100,100 To 300,250
  605.    Ink 4 : Box 105,105 To 295,245
  606.    Ink 5,0 : Text 160,130,"Simple CAD"
  607.    Ink 4,0 : Text 118,160,"Written in AMOS Basic"
  608.    Text 153,190,"By G. Albrow"
  609.    Ink 5,0 : Text 157,220,"August 1992"
  610.    Repeat 
  611.    Until Mouse Key
  612.    REDRAW
  613.    Menu On 
  614.    On Menu On 
  615. End Proc
  616. Procedure _NEW
  617.    For N=0 To NP
  618.       X(N)=0 : Y(N)=0
  619.    Next N
  620.    NP=0
  621.    REDRAW
  622. End Proc
  623. Procedure QUIT
  624.    Default 
  625.    Edit 
  626. End Proc