home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / geos / programming / geoCom.lnx / GEO-3D_com (.txt) next >
Encoding:
GEOS ConVerT  |  1999-06-16  |  11.2 KB  |  235 lines
  1. geo-3d_COM
  2. prg FORMATTED geos FILE v1.0
  3. wRITE iMAGE v2.1
  4. GEOwRITE    v2.1
  5. ***** *) *>*1 g9*******.****. 3* ,9 *< *<{$60}***3
  6. **.****Q*3
  7. {$60}*i@*
  8. *1*****a***9 L&******
  9. {$60} qUELLTEXT ZUR GEOcom-dEMODISKETTE {$60}
  10. {$60} (C)94 by denis d\hler/falk rehwagen{$60}
  11. {$60} dIE dEMODISKETTE KANN KOSTENLOS ANGEFORDERT {$60}
  12. {$60} WERDEN BEI: {$60}
  13. {$60} guss, dENIS d{$7c}HLER , gORKISTR.18 , 04347 lEIPZIG {$60}
  14. name"geo-3d"
  15. author"rEHWAGEN//d{$7c}HLER"
  16. class"GEO-3d      v1.3"
  17. code$2800,$4500 : const$4500,$5000 : var$5000,$6000 : startflag $40
  18. bytevar VERBINDUNGEN,PUNKTANZAHL
  19. bytevar at $84B3; SELECTION
  20. row 50 realvar X,Y,Z
  21. row 100 bytevar VA,VB
  22. row 50 realvar XB,YB,XA,YA,ZA
  23. intvarINPUTROUT
  24. bytevarat$39;PRESSFLAG
  25. row 9 realvar M
  26. bytevarI,ZZ,VV,G,U,Z{$7b}HLER,EDIT
  27. realvar W1,W2,W3,T,M0,X0,Y0,X1,Y1,Z1
  28. strvar 3;PT,VT
  29. strvar 3;WINKEL1,WINKEL2,WINKEL3,OA1,OA2,OA3,MA{$7e}STAB,OX,OY
  30. filevarDATEI
  31. label INFOROUT,VERBUNDTABROUT,DARSTELLEN,PUNKTTABROUT,VERLASSEN,HILFEROUT,TASTATUR,MAUSKLICK,ANFANG,WINKEL_ZEIGEN
  32. label EINGABEENDE,MAUSKL_2,WINKEL_EINGEB
  33.   @ANFANG
  34.   cls : pattern0
  35. rect(dbl258,0),0,(dbl319,1),15 : frame(dbl258,0),0,(dbl319,1),15
  36.   rect0,16,(dbl103,1),199 : frame(dbl1,1),17,(dbl102,0),178
  37.   frame(dbl1,1),178,(dbl102,0),198 : setpos(dbl6,0),192 : print"/b/oGEO-3d v1.3/p"
  38.   rect0,0,(dbl73,0),14  : frame0,0,(dbl30,0),14 : setpos(dbl5,0),10 : print"QUIT" 
  39.   frame(dbl30,0),0,(dbl73,0),14 : setpos(dbl37,0),10 : print"ZEIGEN" 
  40. WINKEL1="0" : WINKEL2="10" : WINKEL3="10"
  41.   OA1="0.5" : OA2="2.0" : OA3="0.5"
  42.   MA{$7e}STAB="40" : OX="108" : OY="70"
  43.   VERBINDUNGEN=12 : PUNKTANZAHL=8
  44.  (X<0>)=0 : (Y<0>)=0 : (Z<0>)=0 : (X<1>)=1 : (Y<1>)=0 : (Z<1>)=0
  45.  (X<2>)=1 : (Y<2>)=1 : (Z<2>)=0 : (X<3>)=0 : (Y<3>)=1 : (Z<3>)=0
  46.  (X<4>)=0 : (Y<4>)=0 : (Z<4>)=1 : (X<5>)=1 : (Y<5>)=0 : (Z<5>)=1
  47.  (X<6>)=1 : (Y<6>)=1 : (Z<6>)=1 : (X<7>)=0 : (Y<7>)=1 : (Z<7>)=1
  48.  (VA<0>)=0 : (VB<0>)=1 : (VA<1>)=1 : (VB<1>)=2
  49.  (VA<2>)=2 : (VB<2>)=3 : (VA<3>)=3 : (VB<3>)=0
  50.  (VA<4>)=4 : (VB<4>)=5 : (VA<5>)=5 : (VB<5>)=6
  51.  (VA<6>)=6 : (VB<6>)=7 : (VA<7>)=7 : (VB<7>)=4
  52.  (VA<8>)=0 : (VB<8>)=4 : (VA<9>)=1 : (VB<9>)=5
  53.  (VA<10>)=2 : (VB<10>)=6 : (VA<11>)=3 : (VB<11>)=7
  54.  WINKEL_ZEIGEN
  55. DARSTELLEN
  56.   mouseon
  57. gosubWINKEL_EINGEB : on 1 goto MAUSKLICK : mainloop
  58. @WINKEL_ZEIGEN
  59.   pattern0 : rect(dbl2,0),18,(dbl101,1),176
  60. setpos(dbl5,0),30:print"/bwINKEL 1:/p" : frame(dbl60,0),20,(dbl95,0),35 : setpos(dbl65,0),30 : printWINKEL1
  61.   setpos(dbl5,0),50:print"/bwINKEL 2:/p" : frame(dbl60,0),40,(dbl95,0),55 : setpos(dbl65,0),50 : printWINKEL2
  62.   setpos(dbl5,0),70:print"/bwINKEL 3:/p" : frame(dbl60,0),60,(dbl95,0),75 : setpos(dbl65,0),70 : printWINKEL3
  63.   setpos(dbl5,0),90 : print"/bmA{$7e}
  64. STAB:/p" : 
  65. frame(dbl60,0),80,(dbl95,0),95 : 
  66. setpos(dbl65,0),90 : printMA
  67.   setpos(dbl5,0),110 : print"/bX0:/p" : 
  68. frame(dbl60,0),100,(dbl95,0),115 : 
  69. setpos(dbl65,0),110 : printOX
  70.   setpos(dbl5,0),130 : print"/bY0:/p" : 
  71. frame(dbl60,0),120,(dbl95,0),135 : 
  72. setpos(dbl65,0),130 : printOY
  73.   setpos(dbl5,0),150 : print"/bpUNKTE:/p" : 
  74. frame(dbl60,0),140,(dbl95,0),155 : 
  75. setpos(dbl65,0),150 : print(strPUNKTANZAHL)
  76.   setpos(dbl5,0),170 : print"/blINIEN:/p" : 
  77. frame(dbl60,0),160,(dbl95,0),175 : 
  78. setpos(dbl65,0),170 : print(strVERBINDUNGEN)
  79. return
  80. DARSTELLEN
  81.   firstmenu
  82.   rect(dbl260,0),2,(dbl318,1),13
  83.   setpos(dbl265,0),10 : print"BERECHNEN"
  84.   W1=(valWINKEL1):W2=(valWINKEL2):W3=(valWINKEL3)
  85.   M0=(valMA
  86. STAB):X0=(valOX):Y0=(valOY)
  87.   if (W1>=360) then : W1=(W1-((floor(W1/360))*360)) : endif
  88.   if (W2>=360) then : W2=(W2-((floor(W2/360))*360)) : endif
  89.   if (W3>=360) then : W3=(W3-((floor(W3/360))*360)) : endif
  90.   T=(3.1415927/180)
  91.   W1=(W1*T):W2=(W2*T):W3=(W3*T)
  92. <0>)=((cosW2)*(cosW3))
  93.   (M<3>)=(-((cosW2)*(sinW3)))
  94.   (M<6>)=(sinW2)
  95.   (M<1>)=(((cosW1)*(sinW3))+(((sinW1)*(sinW2))*(cosW3)))
  96.   (M<4>)=(((cosW1)*(cosW3))-(((sinW1)*(sinW2))*(sinW3)))
  97.   (M<7>)=(-((sinW1)*(cosW2)))
  98.   (M<2>)=(((sinW1)*(sinW3))-(((cosW1)*(sinW2))*(cosW3)))
  99.   (M<5>)=(((sinW1)*(cosW3))+(((cosW1)*(sinW2))*(sinW3)))
  100.   (M<8>)=((cosW1)*(cosW2))
  101.   rect(dbl260,0),2,(dbl318,1),13
  102.   setpos(dbl265,0),10 : print"DARSTELLEN"
  103.   I=0  : repeat
  104.   (XA<I>)=((((M<0>)*(X<I>))+((M<3>)*(Y<I>)))+((M<6>)*(Z<I>)))
  105.   (YA<I>)=((((M<1>)*(X<I>))+((M<4>)*(Y<I>)))+((M<7>)*(Z<I>)))
  106.   (ZA<I>)=((((M<2>)*(X<I>))+((M<5>)*(Y<I>)))+((M<8>)*(Z<I>)))
  107.   if(((YA<I>)-2)==0) then : T=0 : else : T=((YA<I>)/((YA<I>)-2)) : endif
  108.     X1=(M0*((XA<I>)-(T*((XA<I>)-0.5)))):Z1=(M0*((ZA<I>)-(T*((ZA<I>)+(-0.8))))
  109.     (XB<I>)=((104+X0)+X1):(YB<I>)=((16+Y0)+Z1)
  110.     incI
  111.   until(I==PUNKTANZAHL)
  112.   rect(dbl103,0),16,(dbl319,1),199
  113.   I=0 : repeat
  114.     VV=(VA<I>):ZZ=(VB<I>)
  115.    if(not(((floor(XB<VV>))==(floor(XB<ZZ>)))and((floor(YB<VV>))==(floor(YB<ZZ>))))))then
  116.       line(dbl(int(XB<VV>)),0),(byte(YB<VV>)),(dbl(int(XB<ZZ>)),0),(byte(YB<ZZ>))
  117.     endif
  118.     incI
  119.   until(I==VERBINDUNGEN)
  120. return
  121. @WINKEL_EINGEB
  122. rect(dbl260,0),2,(dbl318,1),13
  123. setpos(dbl265,0),10 : print"eINGABE"
  124. if(EDIT==0) : setpos(dbl65,0),30 : setinpWINKEL1,EINGABEENDE : endif
  125. if(EDIT==1) : setpos(dbl65,0),50 : setinpWINKEL2,EINGABEENDE : endif
  126. if(EDIT==2) : setpos(dbl65,0),70 : setinpWINKEL3,EINGABEENDE : endif
  127. if(EDIT==3) : setpos(dbl65,0),90 : setinpMA{$7e}STAB,EINGABEENDE : endif
  128. if(EDIT==4) : setpos(dbl65,0),110 : setinpOX,EINGABEENDE : endif
  129. if(EDIT==5) : setpos(dbl65,0),130 : setinpOY,EINGABEENDE : endif
  130. INPUTROUT=(intat $84A3) : on 0 goto TASTATUR
  131. return
  132. @EINGABEENDE
  133. gosubWINKEL_EINGEB
  134. mainloop
  135. VERLASSEN
  136. INFOROUT
  137.   firstmenu
  138.   strnbox"/bGEO-3d vERSION 1.3","1992 BY fALK rEHWAGEN","1993 BY dENIS d{$7c}HLER"
  139. mainloop
  140. @HILFEROUT
  141.   firstmenu
  142.   rect(dbl5,0),20,(dbl314,0),190 : frame(dbl5,0),20,(dbl314,0),190
  143.   setpos(dbl10,0),30 : print"/beRL{$7b}UTERUNGEN:"
  144.   setpos(dbl10,0),45 : print"GEO-3d IST EIN dEMO-pROGRAMM F{$7d}R zENTRALPROJEKTIONS-"
  145.   setpos(dbl10,0),60 : print"BERECHNUNG UND -DARSTELLUNG. dIE vERZERRUNGFAKTOREN"
  146.   setpos(dbl10,0),75 : print"WURDEN AUS bERECHNUNGSGR{$7d}NDEN FESTGELEGT. sIE K{$7c}NNEN"
  147.   setpos(dbl10,0),90 : print"DIESE wERTE NICHT {$7b}NDERN. /p"
  148.   wait250 : wait 150
  149. gotoANFANG
  150. VERBUNDTABROUT
  151. firstmenu
  152. Z{$7b}HLER=0
  153. pattern0 : rect(dbl260,0),2,(dbl317,0),13
  154. setpos(dbl265,0),10 : print"eINGABE"
  155. rect(dbl3,0),18,(dbl101,1),71 : frame(dbl1,1),17,(dbl102,0),71
  156. setpos(dbl5,0),30 : print"/bvERBINDUNGEN:/p"
  157. setpos(dbl5,0),44 : print"/blINIE A( "; : print(strZ{$7b}HLER); : print" ):/p"
  158. setpos(dbl5,0),58 : print"/blINIE B( "; : print(strZ{$7b}HLER); : print" ):/p"
  159. VT=(strVERBINDUNGEN)
  160. setpos(dbl80,0),30 : input VT : VERBINDUNGEN=(byte(realVT))
  161. Z{$7b}HLER=0 : repeat
  162. if(SCRFLAG==$80)then
  163.   setpos68,44 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  164.   setpos68,58 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  165.   setpos51,44 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  166.   setpos51,58 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  167. endif
  168. VT=(str(VA<Z{$7b}HLER>) : setpos(dbl80,0),44 : inputVT : (VA<Z{$7b}HLER>)=(byte(realVT))
  169. VT=(str(VB<Z{$7b}HLER>) : setpos(dbl80,0),58 : inputVT : (VB<Z{$7b}HLER>)=(byte(realVT))
  170. rect(dbl54,0),52,(dbl100,0),70 : incZ{$7b}HLER
  171. until(Z{$7b}HLER==VERBINDUNGEN)
  172. WINKEL_ZEIGEN : 
  173. WINKEL_EINGEB : mainloop
  174. PUNKTTABROUT
  175. firstmenu
  176. Z{$7b}HLER=0
  177. pattern0 : rect(dbl260,0),2,(dbl317,0),13
  178. setpos(dbl265,0),10 : print"eINGABE"
  179. rect(dbl3,0),19,(dbl100,1),86 : frame(dbl1,1),17,(dbl102,0),86
  180. setpos(dbl5,0),30 : print"/bpUNKTE:/p"
  181. setpos(dbl5,0),44 : print"/bpUNKT X( "; : print(strZ{$7b}HLER); : print" ):/p"
  182. setpos(dbl5,0),58 : print"/bpUNKT Y( "; : print(strZ{$7b}HLER); : print" ):/p"
  183. setpos(dbl5,0),72 : print"/bpUNKT Z( "; : print(strZ{$7b}HLER); : print" ):/p"
  184. PT=(strPUNKTANZAHL) : setpos(dbl80,0),30 : input PT : PUNKTANZAHL=(byte(realPT))
  185. Z{$7b}HLER=0 : repeat
  186. if(SCRFLAG==$80)then
  187.   setpos77,44 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  188.   setpos76,58 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  189.   setpos76,72 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  190.   setpos57,44 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  191.   setpos56,58 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  192.   setpos56,72 : print"/b"; : print(strZ{$7b}HLER); : print" ): /p"
  193. endif
  194. PT=(str(X<Z{$7b}HLER>) : setpos(dbl80,0),44 : inputPT : (X<Z{$7b}HLER>)=(realPT)
  195. PT=(str(Y<Z{$7b}HLER>) : setpos(dbl80,0),58 : inputPT : (Y<Z{$7b}HLER>)=(realPT)
  196. PT=(str(Z<Z{$7b}HLER>) : setpos(dbl80,0),72 : inputPT : (Z<Z{$7b}HLER>)=(realPT)
  197. rect(dbl54,0),52,(dbl100,0),80 : incZ{$7b}HLER
  198. until(Z{$7b}HLER==PUNKTANZAHL)
  199. WINKEL_ZEIGEN : WINKEL_EINGEB : mainloop
  200. TASTATUR
  201.   until(PRESSFLAG==0)
  202.   if (KEYDATA==$E9) goto INFOROUT 
  203.   if (KEYDATA==$E8) goto HILFEROUT 
  204.   if (KEYDATA==$F0) goto PUNKTTABROUT
  205.   if (KEYDATA==$F6) goto VERBUNDTABROUT 
  206.   if (KEYDATA==$F1) goto VERLASSEN 
  207.   if (KEYDATA==$14) then : switch : gotoANFANG : endif
  208.   if ((KEYDATA==13)or(KEYDATA==17)) : incEDIT : if(EDIT==6) : EDIT=0 : endif : endif
  209.   if (KEYDATA==16) : decEDIT : if(EDIT==255) : EDIT=5 : endif : endif
  210.   if ((KEYDATA==16)or(KEYDATA==17)) : poke$8504,13 : endif
  211.   callINPUTROUT
  212. return
  213. MAUSKLICK
  214.   until(MOUSEDATA==0) : interrupt off
  215.   if (region(dbl60,0),140,(dbl95,0),155) : interrupton : gotoPUNKTTABROUT : endif
  216.   if (region(dbl60,0),160,(dbl95,0),175) : interrupton : gotoVERBUNDTABROUT : endif
  217.   if (region(dbl
  218. 30,0),0,(dbl73,0),14 : interrupton : invert
  219. 31,0),1,(dbl72,1),13 : waitSELECTION : invert
  220. 31,0),1,(dbl72,1),13
  221. DARSTELLEN : gosubWINKEL_EINGEB : endif
  222.   if (region0,1,(dbl29,0),13) : interrupton : invert1,1,(dbl29,1),13 : waitSELECTION : invert1,1,(dbl29,1),13 : gotoVERLASSEN : endif
  223. if (region(dbl60,0),20,(dbl95,0),35) : EDIT=5 : gotoMAUSKL_2 : endif
  224.   if (region(dbl60,0),40,(dbl95,0),55) : EDIT=0 : gotoMAUSKL_2 : endif
  225.   if (region(dbl60,0),60,(dbl95,0),75) : EDIT=1 : gotoMAUSKL_2 : endif
  226.   if (region(dbl60,0),80,(dbl95,0),95) : EDIT=2 : gotoMAUSKL_2 : endif
  227. if (region(dbl60,0),100,(dbl95,0),115) : EDIT=3 : gotoMAUSKL_2 : endif
  228. if (region(dbl60,0),120,(dbl95,0),135) : EDIT=4 : gotoMAUSKL_2 : endif
  229.   interrupt on
  230. return
  231. @MAUSKL_2
  232. interrupt on
  233. quitinp
  234. return
  235.