WBStartup AMIGA ;AddVarTrace var,variable$,display_mode DEFTYPE .f demo.b=False ;Kokeile arvolla demo=True... bug.b=False wrbug=False xmaxx.f=320 ymaxx.f=256 T$="Manual:Push LMB.Long=Slow,Short=Fast " Screen 0,0,0,xmaxx,ymaxx,4,$0,T$,1,0 Window 0,0,0,xmaxx,ymaxx,4,T$,0,1 xmin.f=4 ymin.f=11 xmax=xmaxx-xmin ymax=ymaxx-2 fkor=11 LoadFont 0,"topaz.font",fkor WindowFont 0 ScreensBitMap 0,0 LoadPalette 0,"Roinat/pajatso.col" Use Palette 0 LoadShape 0,"Roinat/klaava2.bsh" LoadShape 1,"Roinat/kruuna2.bsh" LoadShape 2,"Roinat/eur2.bsh" LoadShape 3,"Roinat/eur.bsh" WBlit 3,xmax-ShapeWidth(3),ymax-ShapeHeight(3) Free Shape 3 LoadShape 3,"sormi.bsh" LoadSound 0,"klick" Dim kork(2) Dim levk(2) For i=0 To 2 kork(i)=ShapeHeight(i):levk(i)=ShapeWidth(i) If kork oikea reuna - x< ; 4: oikealta -> vasenreuna - x> ; 1: alhaalta -> ylreuna - y< ; 2: ylhlt -> alareuna - y> ; plkm=4 Dim suunta.b(jlkm+plkm) Restore suunnat For i=0 To jlkm:Read suunt:suunta(i)=suunt:Next i ; 0 1 2 3 4 5 6 7 8 9 1011 suunnat Data 0,4,3,2,1,3,2,4,2,3,2,4 Dim yl(jlkm) ;Taulukko niille, joihin tullaan ylhlt ;Tt tarvitaan heittokerran loppumisen ;tarkastelussa ts. tarkastetaan onko ;kolikko jnnyt jonkin vaakatasossa ;olevan janan plle. j=1 For i=1 To jlkm If suunta(i)=2 yl(j)=i j=j+1 EndIf Next i yl(j)=9999 Dim p(1,plkm) ;Taulukko kulmapisteille, joihin trmmist ;tutkitaan eritavalla kuin janoihin trmmsit p(0,1)=kx0 p(1,1)=ky0 p(0,2)=rx0 p(1,2)=ry0 p(0,3)=rx1 p(1,3)=ry1 p(0,4)=kx1 p(1,4)=kx0 For i=0 To plkm-1 suunta(i+jlkm)=5 Next i Dim skaala(1,4) skaala(0,1)=1:skaala(1,1)=0 skaala(0,2)=1:skaala(1,2)=2 skaala(0,3)=2:skaala(1,3)=1 skaala(0,4)=0:skaala(1,4)=1 ;Onko x x1:n ja x2:n vliss? Function .b btw{x,x1,x2} Function Return x>=Min(x1,x2) AND x<=Max(x1,x2) End Function ;pisteitten x1,x2 ja x3,x4 vlinen etisyys Function et{x1,x2,x3,x4} x1=x3-x1 x2=x4-x2 x1=x1*x1 x2=x2*x2 Function Return Sqr(x1+x2) End Function ;**** Funktiot valmiina **** Parit tulostus rutiinit **** Dim kolikko.q(2,2) ;taulukossa lukumrrt ja sen tulostusvarit kolikko(0,0)=0:kolikko(1,0)=11:kolikko(2,0)=10 kolikko(0,1)=0:kolikko(1,1)=6:kolikko(2,1)=9 kolikko(0,2)=0:kolikko(1,2)=9:kolikko(2,2)=5 ; Tulostaa merkkijonon paikkaan x,y varill vari1 ja ; paikkaan x+1,y+1 varilla vari2 Statement tulosta{t$,x,y,vari1,vari2} WLocate x,y WColour vari1 WJam 1 NPrint t$ WLocate x+1,y+1 WColour vari2 WJam 0 NPrint t$ End Statement Restore otsikot If bug=False For i=0 To 17 Read t$:Read vari1,vari2 If i<=13 tulosta{t$,xmin+4,ymin+4+i*fkor,vari1,vari2} Else tulosta{t$,fkor*11,(i-14)*fkor+ymin+4,vari1,vari2} EndIf Next i EndIf .otsikot ;Teksti ja sen kaksi tulostusvri Data$ "JASSOO!" Data 5,4 Data$ "VAI NIIN?" Data 13,4 Data$ " " Data 4,3 Data$ "KULUTETTU:" Data 4,2 Data$ " 0.00 FIM" Data 4,7 Data$ " 0.00 EUR" Data 6,11 Data$ " " Data 14,7 Data$ "VOITETTU:" Data 4,11 Data$ " 0.00 FIM" Data 4,14 Data$ " 0.00 EUR" Data 4,15 Data$ " " Data 5,4 Data$ "SALDO:" Data 2,11 Data$ "+ 0.00 FIM" Data 14,11 Data$ "+ 0.00 EUR" Data 13,11 Data$ "Heitot" Data 11,7 Data$ "Klaavat: 0 kpl" Data 11,10 Data$ "Kruunat: 0 kpl" Data 6,9 Data$ "Eurot: 0 kpl" Data 4,5 WJam 0 WLocate xmin+4,ymax-3*fkor WColour 4 NPrint "Made by" WLocate xmin+4,ymax-2*fkor NPrint "Hrh 1998" WColour 5 WLocate xmin+4,ymax-3*fkor-1 NPrint "Made by" WLocate xmin+4,ymax-2*fkor-1 NPrint "Hrh 1998" Dim p(1,4);vaikka kolikoita on vain yksi tss versiossa niin kolikon ;kulun edelliset ja uudet koordinaatit laitetaan ;Dummy taulukkoon ohjelman kehityst silmllpiten ;ei laitettukaan, mutta tullaan laittamaan... If bug=True Then Format "+####0.####" ; A l k u v a l m i s t e l u t o n t e h t y . ; Jatketaan niit.... .paaluuppi mb=0 ;mb asetetaan kolmeksi kun lopetetaan painamalla RMB ja LMB Repeat ;niin kauan toistetaan klaava.q=Int(Rnd(3)) ;arvotaan kolikko x=xmax-levk(klaava)-2 ;alkukoordinaatat kolikolle y0=ymin+2:y=y0 vsr=0:vsl=0 ;kilahdusnen voimakkuus right ja left rx=levk(klaava)/2 ry=kork(klaava)/2 If bug=False If xymaxx-kork(klaava)-20 Then Stop BBlit 0,klaava,x,y Else Circle x+rx,y+ry,rx,ry,4 EndIf If mb<>3 Then mb=Joyb(0) ux=x+vx:ux(0)=ux uy=y+vy:uy(0)=uy If bug=True Then Gosub buggaa1 ;tutkitaan onko trmmss janoihin ja ;mihin lhinn For jana=1 To jlkm:ux(jana)=-999:uy(jana)=-999:Next jana ;Lasketaan trmyspiste. Ensin skaalataan neljt ;shapen sivustapisteet ;Allaolevassa koodinptkss meinasi menn indeksit ;moneen kertaan sekaisin jana=0:pet=9999 If ux<>x kk=(uy-y)/(ux-x) If vx<0 suunta=4 Gosub skaalaa j=1:Gosub tarkistaj j=7:Gosub tarkistaj j=11:Gosub tarkistaj Else suunta=3 Gosub skaalaa j=5:Gosub tarkistaj j=9:Gosub tarkistaj j=2:Gosub tarkistaj EndIf If vy<0 suunta=1 Gosub skaalaa j=4:Gosub tarkistaj Else suunta=2 Gosub skaalaa j=3:Gosub tarkistaj j=6:Gosub tarkistaj j=8:Gosub tarkistaj j=10:Gosub tarkistaj EndIf Else ; Kulkusuunta pystysuora ei tarvitse laskea kulmakerrointa ;...eikun ei saa laskea...GURU by division Zero For j=1 To jlkm suunta=suunta(j) If suunta=1 OR suunta=2 If btw{jx(j,2),x1,x2} uy2=jx(j,2)+skaalay ux2=ux et=y Gosub vaihtoko EndIf EndIf Next j EndIf ; ;;ent kulmapisteet? ; For p=1 To 4 ; j=jlkm+p ; XX=p(0,p) ; YY=p(1,p) ; rxx=rx*rx ; ryy=ry*ry ; kkk=kk*kk ; a=1/kkk/rxx ; a=a+(1/ryy) ; ; b1=-2*XX/kk/rxx ; b2=b1-(2*x1/kkk/rxx) ; b3=2*y1/kkk/rxx ; b4=-2*YY/ryy ; b=b1+b2+b3+b4 ; ; c1=(XX*XX-(2*x1*XX))/rxx ; c2=2*y1*XX/kk/rxx ; c3=(x1*x1-2*x1*y1)/kkk/rxx ; c4=y1*y1/kkk/rxx ; c5=(YY/ryy)-1 ; c=c1+c2+c3+c4+c5 ; ; apu1=4*a*c ; apu2=b*b ; If apu2-apu1>=0 ; neli=Sqr(b*b-4*a*c)/2/a ; y1=-b+neli ; y2=-b-neli ; ux2=x1+(y-y1)/kk ; uy2=y1 ; et=et{ux2,uy2,XX,YY} ; Gosub vaihtoko ; uy2=y2 ; et=et{ux2,uy2,XX,YY} ; Gosub vaihtoko ; EndIf ; Next p If jana<>0 AND jana<=jlkm Gosub ssound ; trmttiin janaan Else If jana>jlkm ;trmttiin kulmaan EndIf EndIf If bug=True Then Gosub buggaa2 ; ;tulosuunta kertoo mys mik liike muuttuu Select suunta(jana) Case 1 xbong=1:ybong=-1 Case 2 xbong=1:ybong=-1 Case 3 xbong=-1:ybong=1 Case 4 xbong=-1:ybong=1 Case 5 xbong=-1:ybong=-1 Default xbong=1/bong:ybong=1/bong End Select vx=xbong*vx*bong vy=ybong*vy*bong x=ux y=uy uvx=vx+ax If uvx*vx<0 ;blitzin Sgn(a) ei toimi jos -19999 AND loppuu=False If vy<1 AND vauhti<3 If btw{ux+rx,jx(ylj,1),jx(ylj,3)} If btw{uy,jx(ylj,2)-2*ry-2,jx(ylj,2)} loppuu=True If ylj=8 ; Osuma!!!!!!!!!!!! If klaava=1 OR klaava=0 k=1 Else k=eurok EndIf voitfim=voitfim+10*k EndIf EndIf EndIf EndIf j=j+1 ylj=yl(j) Wend Until (mb=3) OR loppuu=True If mb<>3 VWait UnBuffer 0 BBlit 0,klaava,x,y EndIf .tulnum WindowOutput 0 kulutfim=kulutfim+Abs(klaava=0 OR klaava=1)+Abs(klaava=2)*eurok Format "####0.00" apu=ymin+4+4*fkor ap=xmin+4 tulosta{Str$(kulutfim),ap,apu,4,7} tulosta{Str$(kulutfim/eurok),ap,apu+fkor,6,fkor} ;------------------------------------- tulosta{Str$(voitfim),ap,apu+4*fkor,4,14} tulosta{Str$(voitfim/eurok),ap,apu+5*fkor,4,15} ;----------------------------------- Format "+###0.00" saldofim=voitfim-kulutfim tulosta{Str$(saldofim),ap,apu+8*fkor,14,fkor} tulosta{Str$(saldofim/eurok),ap,apu+9*fkor,13,fkor} Until mb=3 ;CloseFile 1 Stop .tarkistaj If suunta=3 OR suunta=4 uy2=kk*(jx(j,1)-x1)+y1 If btw{uy2,jx(j,2),jx(j,4)} If btw{jx(j,1),x1,x2} uy2=uy2-skaalay ux2=jx(j,1)-skaalax et=et{x,y,ux2,uy2} Gosub vaihtoko EndIf EndIf Else ;suunta yls tai alas eli 1 tai 2 ux2=x1+(jx(j,2)-y1)/kk If btw{ux2,jx(j,1),jx(j,3)} If btw{jx(j,2),y1,y2} ux2=ux2-skaalax uy2=jx(j,2)-skaalay et=et{x,y,ux2,uy2} Gosub vaihtoko EndIf EndIf EndIf Return skaalaa skaalax=skaala(0,suunta)*rx skaalay=skaala(1,suunta)*ry x1=x+skaalax x2=ux+skaalax y1=y+skaalay y2=uy+skaalay Return vaihtoko If et1 Else kesto=Rnd(maxkesto-minkesto) For di=1 To kesto VWait UnBuffer 1 BBlit 1,3,xmaxx-sorml,y0-sormky Next di EndIf VWait UnBuffer 1 BBlit 1,3,xmaxx-sorml,y0-sormky UnBuffer 1 Return Macro Tauko Repeat VWait mbj=Joyb(0) Until mbj=1 Repeat VWait mbj=Joyb(0) Until mbj<>1 End Macro .buggaa1 Box kx0,ky0,kx1,ky1,7 Box rx0,ry0,rx1,ry1,7 Line rx0,ry0,rx1,ry0,0 WJam 1 WColour 14 Format "+###.##" WColour 4 NPrint "x=",x," y=",y WColour 5 NPrint "ux=",ux," uy=",uy NPrint "ux2=",ux+2*rx," uy2=",uy+2*ry WColour 6 NPrint "vx=",vx," vy=",vy Box x,y,x+2*rx,y+2*ry,4 ;mist Line x,y,ux,uy,6 ;mist mihin Box ux,uy,ux+2*rx,uy+2*ry,5 ;mihin Circle ux+rx,uy+ry,rx,ry,5 Return .buggaa2 Box ux,uy,ux+2*rx,uy+2*ry,9;mihin Circle ux+rx,uy+ry,rx,ry,9 WColour 9 NPrint "ux=",ux," uy=",uy Box xmin,ymin,xmax,ymax,8 px=WCursX py=WCursY If py>ymax-fkor Then py=0 WLocate 150,ymin NPrint "xmin=",xmin,"ymin=",ymin WLocate 150,ymin+fkor NPrint "xmax=",xmax,"ymax=",ymax WLocate 150,ymin+2*fkor NPrint "uxmx=",xmax-levk(klaava),"uymx=",ymax-kork(klaava) !Tauko WLocate px,py Return .ssound vsr=Int(11+ux/xmax*4) vsl=Int(11+uy/ymax*4) If vauhti<0.1 Then vsr=2:vsl=2 Sound 0,15,vsl,vsl,vsr,vsr Return .wrbug FileOutput 1 If krt=0 NPrint "xmin=",xmin,"ymin=",ymin NPrint "xmax=",xmax,"ymax=",ymax NPrint "ymaxr=",ymax-2*ry krt=1 EndIf NPrint " " NPrint "x=",x," y=",y NPrint "ux=",ux," uy=",uy NPrint "vx=",vx," vy=",vy NPrint "vauhti=",vauhti Return End