home *** CD-ROM | disk | FTP | other *** search
/ Amiga Computing 57 / ac057a.adf / Demos / triangles.bas < prev    next >
BASIC Source File  |  1989-06-30  |  4KB  |  171 lines
  1. ' HiSoft BASIC demo based on Dreier on the German Extras disk
  2. ' used with permission
  3.  
  4. ' you can load this into AmigaBASIC to see the difference
  5. ' (assumes 80-column text mode)
  6.  
  7. '" dreierneu
  8. '" Demo schnelles Flächenfüllen
  9. '" P. Kittel, CBM Ffm, 4.4.87, 18.6.88
  10.  
  11. 'CLEAR,4000
  12. 'CLEAR,7500
  13.  
  14. sc&=PEEKL(WINDOW(7) + 46) '" Screen-Struktur
  15. Hoehe=PEEKW(sc&+14)       '" Screen-Höhe
  16. IF Hoehe=256 THEN
  17.   ym=250:y1=140:y0=58:ye=119:zl=29 ':PRINT "PAL-Screen"
  18.           ELSE
  19.   ym=200:y1=105:y0=45:ye= 93:zl=20 ':PRINT "NTSC-Screen"
  20. END IF
  21.  
  22. PRINT
  23. PRINT "This program illustrates several things:":?
  24. PRINT "1. How fast the Amiga is at colour graphics"
  25. PRINT "2. How fast HiSoft BASIC for the Amiga is"
  26. PRINT "3. How compatible HiSoft BASIC is with AmigaBASIC,"
  27. PRINT "   the language supplied with every Amiga."
  28. PRINT
  29. PRINT "If you load the file HBDemo.bas into AmigaBASIC you"
  30. PRINT "will be able to see the difference yourself."
  31. PRINT
  32. PRINT "HiSoft BASIC for the Amiga is available from your dealer"
  33. PRINT "or, in case of difficulty, from:"
  34. PRINT "HiSoft, The Old School, Greenfield, Bedford, MK45 5DE, UK"
  35. PRINT "                                      Phone (0525) 718181"
  36. PRINT:PRINT
  37. PRINT "Press any key to begin...";
  38.  
  39. t=TIMER+20
  40. WHILE (INKEY$="") AND (TIMER<t)
  41. WEND
  42.  
  43. fz=0        '1 is prettier but too slow under AmigaBASIC
  44.  
  45. SCREEN 1,570,ym,4,2
  46. IF SYSTAB THEN
  47.     t$=" Compiled with HiSoft BASIC"
  48.     REM $event off
  49.     REM $option a-,e-,x-,b-,o-,n-
  50. ELSE
  51.     t$=" Running under AmigaBASIC"
  52. END IF
  53.  
  54. WINDOW 2,t$+" (ESC to exit)",(0,0)-(500,ym-15),0,1
  55. x1=250
  56. x2=290:y2=y1
  57. z1=0  :z2=0
  58. co=2
  59.  
  60. nn=15
  61. DIM pr(nn),pg(nn),pb(nn),pra(nn+1),pga(nn+1),pba(nn+1)
  62. FOR i=2 TO nn:PALETTE i,0,0,0:NEXT
  63. fr=0:fg=0:fb=0:pf=0:ff=4000:fs=0:c7=7/15:c6=15*16:c2=15*256
  64. cc=0:cf=1:co2=0
  65. PALETTE 0,.5,.5,.5
  66. COLOR 1
  67. LOCATE 1,2:PRINT "Fast";:     LOCATE 1,50:PRINT "Solid fills";
  68. LOCATE 2,2:PRINT "Graphics" ;:LOCATE 2,50:PRINT "using blitter";
  69. IF SYSTAB THEN
  70.     LOCATE zl-1,50:PRINT "All with";
  71.         LOCATE zl  ,50:PRINT "HiSoft BASIC!";
  72. END IF
  73. IF fz THEN
  74.   LOCATE zl/2-1,25:PRINT "Bitte etwas Geduld...";
  75.   END IF
  76. COLOR 2
  77. LOCATE zl-1,2:PRINT "4096";
  78. LOCATE zl  ,2:PRINT "Colours";
  79.  
  80. '" Die Art der Farbweiterschaltung wird
  81. '" durch die Variablen fs und ff in
  82. '" späteren Zeilen bestimmt.
  83. '" Hier ist viel Raum für eigene
  84. '" Experimente.
  85.  
  86. ex$=CHR$(27)
  87.  
  88. WHILE INKEY$<>ex$
  89.  
  90.   x3=x2 :y3=y2
  91.   z1=z1+.01         :IF z1>6.28 THEN z1=0
  92.   z2=z2+.03*SIN(z1) :IF z2>6.28 THEN z2=0
  93.   z3=z3+z1*SIN(z2)/4:IF z3>6.28 THEN z3=0
  94.  
  95.   x2=INT(120*(1+SIN(z2))*COS(z3)+x1)
  96.   y2=INT( y0*(1+SIN(z2))*SIN(z3)+ye)
  97.   AREA (x1,y1):AREA (x2,y2):AREA (x3,y3)
  98.  
  99.   IF fz=0 THEN
  100.     pra(co)=pr(co):pga(co)=pg(co):pba(co)=pb(co)
  101.     PALETTE co,pr(co),pg(co),pb(co)
  102.     END IF
  103.  
  104.   '" Farbweiterschaltung
  105.   co=co+1:IF co>nn THEN
  106.     co=2
  107.     co2=co2+1
  108.     IF co2>1 OR fz=0 THEN
  109.       co2=0
  110.       fs=fs+.1:IF fs>7 THEN fs=fs-7
  111.       ff=ff+273.16*(1+COS(fs)*1.02):IF ff>4095 THEN ff=ff-4095
  112.       fi=INT(ff)
  113.       ar=fr:ag=fg:ab=fb
  114.       fr=(fi AND 15)/15
  115.       fg=(fi AND 15*16 )/c6
  116.       fb=(fi AND 15*256)/c2  
  117.       pr(15)=fr:pg(15)=fg:pb(15)=fb ' neue Farbe
  118.       cc=cc+1:IF cc>20 THEN cc=0:cf=-cf
  119.       IF cf*(fr+ar)>cf THEN
  120.         fr2=2-fr:m=(fr2-ar)/14:a=ar-m
  121.         FOR i=2 TO 14:pr(i)=a+i*m:IF pr(i)>1 THEN pr(i)=2-pr(i)
  122.           NEXT
  123.               ELSE
  124.         fr2=-fr:m=(fr2-ar)/14:a=ar-m
  125.         FOR i=2 TO 14:pr(i)=a+i*m:IF pr(i)<0 THEN pr(i)=-pr(i)
  126.           NEXT
  127.         END IF
  128.       IF cf*(fg+ag)>cf THEN
  129.         fg2=2-fg:m=(fg2-ag)/14:a=ag-m
  130.         FOR i=2 TO 14:pg(i)=a+i*m:IF pg(i)>1 THEN pg(i)=2-pg(i)
  131.           NEXT
  132.               ELSE
  133.         fg2=-fg:m=(fg2-ag)/14:a=ag-m
  134.         FOR i=2 TO 14:pg(i)=a+i*m:IF pg(i)<0 THEN pg(i)=-pg(i)
  135.           NEXT
  136.         END IF
  137.       IF cf*(fb+ab)>cf THEN
  138.         fb2=2-fb:m=(fb2-ab)/14:a=ab-m
  139.         FOR i=2 TO 14:pb(i)=a+i*m:IF pb(i)>1 THEN pb(i)=2-pb(i)
  140.           NEXT
  141.               ELSE
  142.         fb2=-fb:m=(fb2-ab)/14:a=ab-m
  143.         FOR i=2 TO 14:pb(i)=a+i*m:IF pb(i)<0 THEN pb(i)=-pb(i)
  144.           NEXT
  145.         END IF
  146.       END IF
  147.     END IF
  148.  
  149.   IF fz THEN
  150.     '" Palette zyklisch umbelegen  
  151.      FOR i=nn+1 TO 3 STEP -1
  152.        pra(i)=pra(i-1): pga(i)=pga(i-1): pba(i)=pba(i-1)
  153.        NEXT
  154.      pra(2)=pra(nn+1): pga(2)=pga(nn+1): pba(2)=pba(nn+1)
  155.      cd=2*co-2: IF cd>nn THEN cd=cd-nn+1
  156.      pra(cd)=pr(co):   pga(cd)=pg(co):   pba(cd)=pb(co)
  157.      FOR i=2 TO nn:PALETTE i,pra(i),pga(i),pba(i):NEXT
  158.      END IF
  159.  
  160.   COLOR co
  161.   AREAFILL
  162.   WEND
  163.  
  164. '" Am Schluß sauber aufräumen
  165. WINDOW CLOSE 2
  166. SCREEN CLOSE 1
  167. IF SYSTAB THEN SYSTEM
  168. END
  169.  
  170.  
  171.